Theory Generated_Subalgebra
section ‹Generated subalgebras›
text ‹This section contains definitions and properties related to generated subalgebras.›
theory Generated_Subalgebra imports "HOL-Probability.Probability"
begin
definition gen_subalgebra where
"gen_subalgebra M G = sigma (space M) G"
lemma gen_subalgebra_space:
shows "space (gen_subalgebra M G) = space M"
by (simp add: gen_subalgebra_def space_measure_of_conv)
lemma gen_subalgebra_sets:
assumes "G ⊆ sets M"
and "A ∈ G"
shows "A ∈ sets (gen_subalgebra M G)"
by (metis assms gen_subalgebra_def sets.space_closed sets_measure_of sigma_sets.Basic subset_trans)
lemma gen_subalgebra_sig_sets:
assumes "G ⊆ Pow (space M)"
shows "sets (gen_subalgebra M G) = sigma_sets (space M) G" unfolding gen_subalgebra_def
by (metis assms gen_subalgebra_def sets_measure_of)
lemma gen_subalgebra_sigma_sets:
assumes "G ⊆ sets M"
and "sigma_algebra (space M) G"
shows "sets (gen_subalgebra M G) = G"
using assms by (simp add: gen_subalgebra_def sigma_algebra.sets_measure_of_eq)
lemma gen_subalgebra_is_subalgebra:
assumes sub: "G ⊆ sets M"
and sigal:"sigma_algebra (space M) G"
shows "subalgebra M (gen_subalgebra M G)" (is "subalgebra M ?N")
unfolding subalgebra_def
proof (intro conjI)
show "space ?N = space M" using space_measure_of_conv[of "(space M)"] unfolding gen_subalgebra_def by simp
have geqn: "G = sets ?N" using assms by (simp add:gen_subalgebra_sigma_sets)
thus "sets ?N ⊆ sets M" using assms by simp
qed
definition fct_gen_subalgebra :: "'a measure ⇒ 'b measure ⇒ ('a ⇒ 'b) ⇒ 'a measure" where
"fct_gen_subalgebra M N X = gen_subalgebra M (sigma_sets (space M) {X -` B ∩ (space M) | B. B ∈ sets N})"
lemma fct_gen_subalgebra_sets:
shows "sets (fct_gen_subalgebra M N X) = sigma_sets (space M) {X -` B ∩ space M |B. B ∈ sets N}"
unfolding fct_gen_subalgebra_def gen_subalgebra_def
proof -
have "{X -` B ∩ space M |B. B ∈ sets N} ⊆ Pow (space M)"
by blast
then show "sets (sigma (space M) (sigma_sets (space M) {X -` B ∩ space M |B. B ∈ sets N})) = sigma_sets (space M) {X -` B ∩ space M |B. B ∈ sets N}"
by (meson sigma_algebra.sets_measure_of_eq sigma_algebra_sigma_sets)
qed
lemma fct_gen_subalgebra_space:
shows "space (fct_gen_subalgebra M N X) = space M"
unfolding fct_gen_subalgebra_def by (simp add: gen_subalgebra_space)
lemma fct_gen_subalgebra_eq_sets:
assumes "sets M = sets P"
shows "fct_gen_subalgebra M N X = fct_gen_subalgebra P N X"
proof -
have "space M = space P" using sets_eq_imp_space_eq assms by auto
thus ?thesis unfolding fct_gen_subalgebra_def gen_subalgebra_def by simp
qed
lemma fct_gen_subalgebra_sets_mem:
assumes "B∈ sets N"
shows "X -` B ∩ (space M) ∈ sets (fct_gen_subalgebra M N X)" unfolding fct_gen_subalgebra_def
proof -
have f1: "{X -` A ∩ space M |A. A ∈ sets N} ⊆ Pow (space M)"
by blast
have "∃A. X -` B ∩ space M = X -` A ∩ space M ∧ A ∈ sets N"
by (metis assms)
then show "X -` B ∩ space M ∈ sets (gen_subalgebra M (sigma_sets (space M) {X -` A ∩ space M |A. A ∈ sets N}))"
using f1 by (simp add: gen_subalgebra_def sigma_algebra.sets_measure_of_eq sigma_algebra_sigma_sets)
qed
lemma fct_gen_subalgebra_is_subalgebra:
assumes "X∈ measurable M N"
shows "subalgebra M (fct_gen_subalgebra M N X)"
unfolding fct_gen_subalgebra_def
proof (rule gen_subalgebra_is_subalgebra)
show "sigma_sets (space M) {X -` B ∩ space M |B. B ∈ sets N} ⊆ sets M" (is "?L ⊆ ?R")
proof (rule sigma_algebra.sigma_sets_subset)
show "{X -` B ∩ space M |B. B ∈ sets N} ⊆ sets M"
proof
fix a
assume "a ∈ {X -` B ∩ (space M) | B. B ∈ sets N}"
then obtain B where "B ∈ sets N" and "a = X -` B ∩ (space M)" by auto
thus "a ∈ sets M" using measurable_sets assms by simp
qed
show "sigma_algebra (space M) (sets M)" using measure_space by (auto simp add: measure_space_def)
qed
show "sigma_algebra (space M) ?L"
proof (rule sigma_algebra_sigma_sets)
let ?preimages = "{X -` B ∩ (space M) | B. B ∈ sets N}"
show "?preimages ≤ Pow (space M)" using assms by auto
qed
qed
lemma fct_gen_subalgebra_fct_measurable:
assumes "X ∈ space M → space N"
shows "X∈ measurable (fct_gen_subalgebra M N X) N"
unfolding measurable_def
proof ((intro CollectI), (intro conjI))
have speq: "space M = space (fct_gen_subalgebra M N X)"
by (simp add: fct_gen_subalgebra_space)
show "X ∈ space (fct_gen_subalgebra M N X) → space N"
proof -
have "X ∈ space M → space N" using assms by simp
thus ?thesis using speq by simp
qed
show "∀y∈sets N.
X -` y ∩ space (fct_gen_subalgebra M N X) ∈ sets (fct_gen_subalgebra M N X)"
using fct_gen_subalgebra_sets_mem speq by metis
qed
lemma fct_gen_subalgebra_min:
assumes "subalgebra M P"
and "f∈ measurable P N"
shows "subalgebra P (fct_gen_subalgebra M N f)"
unfolding subalgebra_def
proof (intro conjI)
let ?Mf = "fct_gen_subalgebra M N f"
show "space ?Mf = space P" using assms
by (simp add: fct_gen_subalgebra_def gen_subalgebra_space subalgebra_def)
show inc: "sets ?Mf ⊆ sets P"
proof -
have "space M = space P" using assms by (simp add:subalgebra_def)
have "f∈ measurable M N" using assms using measurable_from_subalg by blast
have "sigma_algebra (space P) (sets P)" using assms measure_space measure_space_def by auto
have "∀ A ∈ sets N. f-`A ∩ space P ∈ sets P" using assms by simp
hence "{f -` A ∩ (space M) | A. A ∈ sets N} ⊆ sets P" using ‹space M = space P› by auto
hence "sigma_sets (space M) {f -` A ∩ (space M) | A. A ∈ sets N} ⊆ sets P"
by (simp add: ‹sigma_algebra (space P) (sets P)› ‹space M = space P› sigma_algebra.sigma_sets_subset)
thus ?thesis using fct_gen_subalgebra_sets ‹f ∈ M →⇩M N› ‹space M = space P› assms(2)
measurable_sets mem_Collect_eq sets.sigma_sets_subset subsetI by blast
qed
qed
lemma fct_preimage_sigma_sets:
assumes "X∈ space M → space N"
shows "sigma_sets (space M) {X -` B ∩ space M |B. B ∈ sets N} = {X -` B ∩ space M |B. B ∈ sets N}" (is "?L = ?R")
proof
show "?R⊆ ?L" by blast
show "?L⊆ ?R"
proof
fix A
assume "A∈ ?L"
thus "A∈ ?R"
proof (induct rule:sigma_sets.induct, auto)
{
fix B
assume "B∈ sets N"
let ?cB = "space N - B"
have "?cB ∈ sets N" by (simp add: ‹B ∈ sets N› sets.compl_sets)
have "space M - X -` B ∩ space M = X -` ?cB ∩ space M"
proof
show "space M - X -` B ∩ space M ⊆ X -` (space N - B) ∩ space M"
proof
fix w
assume "w ∈ space M - X -` B ∩ space M"
hence "X w ∈ (space N - B)" using assms by blast
thus "w∈ X -` (space N - B) ∩ space M" using ‹w ∈ space M - X -` B ∩ space M› by blast
qed
show "X -` (space N - B) ∩ space M ⊆ space M - X -` B ∩ space M"
proof
fix w
assume "w∈ X -` (space N - B) ∩ space M"
thus "w ∈ space M - X -` B ∩ space M" by blast
qed
qed
thus "∃Ba. space M - X -` B ∩ space M = X -` Ba ∩ space M ∧ Ba ∈ sets N" using ‹?cB ∈ sets N› by auto
}
{
fix S::"nat ⇒ 'a set"
assume "(⋀i. ∃B. S i = X -` B ∩ space M ∧ B ∈ sets N)"
hence "(∀i. ∃B. S i = X -` B ∩ space M ∧ B ∈ sets N)" by auto
hence "∃ f. ∀ x. S x = X -`(f x) ∩ space M ∧ (f x) ∈ sets N"
using choice[of "λi B . S i = X -` B ∩ space M ∧ B ∈ sets N"] by simp
from this obtain rep where "∀i. S i = X -` (rep i) ∩ space M ∧ (rep i) ∈ sets N" by auto note rProp = this
let ?uB = "⋃i∈ UNIV. rep i"
have "?uB ∈ sets N"
by (simp add: ‹∀i. S i = X -` rep i ∩ space M ∧ rep i ∈ sets N› countable_Un_Int(1))
have "(⋃x. S x) = X -` ?uB ∩ space M"
proof
show "(⋃x. S x) ⊆ X -` (⋃i. rep i) ∩ space M"
proof
fix w
assume "w∈ (⋃x. S x)"
hence "∃x. w ∈ S x" by auto
from this obtain x where "w ∈ S x" by auto
hence "w∈ X -` rep x ∩ space M" using rProp by simp
hence "w∈ (⋃i. (X -`(rep i)∩ space M))" by blast
also have "... = X -` (⋃i. rep i) ∩ space M" by auto
finally show "w ∈ X -` (⋃i. rep i) ∩ space M" .
qed
show "X -` (⋃i. rep i) ∩ space M ⊆ (⋃x. S x)"
proof
fix w
assume "w∈ X -` (⋃i. rep i) ∩ space M"
hence "∃ x. w∈ X -` (rep x) ∩ space M" by auto
from this obtain x where "w∈ X -` (rep x) ∩ space M" by auto
hence "w∈ S x" using rProp by simp
thus "w∈ (⋃x. S x)" by blast
qed
qed
thus "∃B. (⋃x. S x) = X -` B ∩ space M ∧ B ∈ sets N" using ‹?uB ∈ sets N› by auto
}
qed
qed
qed
lemma fct_gen_subalgebra_sigma_sets:
assumes "X∈ space M → space N"
shows "sets (fct_gen_subalgebra M N X) = {X -` B ∩ space M |B. B ∈ sets N}"
by (simp add: assms fct_gen_subalgebra_sets fct_preimage_sigma_sets)
lemma fct_gen_subalgebra_info:
assumes "f∈ space M → space N"
and "x∈ space M"
and "w∈ space M"
and "f x = f w"
shows "⋀A. A∈ sets (fct_gen_subalgebra M N f) ⟹ (x∈ A) = (w∈ A)"
proof -
{fix A
assume "A ∈ sigma_sets (space M) {f -` B ∩ (space M) | B. B ∈ sets N}"
from this have "(x∈ A) = (w∈ A)"
proof (induct rule:sigma_sets.induct)
{
fix a
assume "a ∈ {f -` B ∩ space M |B. B ∈ sets N}"
hence "∃ B∈ sets N. a = f -` B ∩ space M" by auto
from this obtain B where "B∈ sets N" and "a = f -` B ∩ space M" by blast note bhyps = this
show "(x∈ a) = (w∈ a)" by (simp add: assms(2) assms(3) assms(4) bhyps(2))
}
{
fix a
assume "a ∈ sigma_sets (space M) {f -` B ∩ space M |B. B ∈ sets N}"
and "(x ∈ a) = (w ∈ a)" note xh = this
show "(x ∈ space M - a) = (w ∈ space M - a)" by (simp add: assms(2) assms(3) xh(2))
}
{
fix a::"nat ⇒ 'a set"
assume "(⋀i. a i ∈ sigma_sets (space M) {f -` B ∩ space M |B. B ∈ sets N})"
and "(⋀i. (x ∈ a i) = (w ∈ a i))"
show "(x ∈ ⋃(a ` UNIV)) = (w ∈ ⋃(a ` UNIV))" by (simp add: ‹⋀i. (x ∈ a i) = (w ∈ a i)›)
}
{show "(x∈ {}) = (w∈ {})" by simp}
qed} note eqsig = this
fix A
assume "A∈ sets (fct_gen_subalgebra M N f)"
hence "A ∈ sigma_sets (space M) {f -` B ∩ (space M) | B. B ∈ sets N}"
using assms(1) fct_gen_subalgebra_sets by blast
thus "(x∈ A) = (w∈ A)" using eqsig by simp
qed
subsection ‹Independence between a random variable and a subalgebra.›
definition (in prob_space) subalgebra_indep_var :: "('a ⇒ real) ⇒ 'a measure ⇒ bool" where
"subalgebra_indep_var X N ⟷
X∈ borel_measurable M &
(subalgebra M N) &
(indep_set (sigma_sets (space M) { X -` A ∩ space M | A. A ∈ sets borel}) (sets N))"
lemma (in prob_space) indep_set_mono:
assumes "indep_set A B"
assumes "A' ⊆ A"
assumes "B' ⊆ B"
shows "indep_set A' B'"
by (meson indep_sets2_eq assms subsetCE subset_trans)
lemma (in prob_space) subalgebra_indep_var_indicator:
fixes X::"'a⇒real"
assumes "subalgebra_indep_var X N"
and "X ∈ borel_measurable M"
and "A ∈ sets N"
shows "indep_var borel X borel (indicator A)"
proof ((rule indep_var_eq[THEN iffD2]), (intro conjI))
let ?IA = "(indicator A)::'a⇒ real"
show bm:"random_variable borel X" by (simp add: assms(2))
show "random_variable borel ?IA" using assms indep_setD_ev2 unfolding subalgebra_indep_var_def by auto
show "indep_set (sigma_sets (space M) {X -` A ∩ space M |A. A ∈ sets borel})
(sigma_sets (space M) {?IA -` Aa ∩ space M |Aa. Aa ∈ sets borel})"
proof (rule indep_set_mono)
show "sigma_sets (space M) {X -` A ∩ space M |A. A ∈ sets borel} ⊆ sigma_sets (space M) {X -` A ∩ space M |A. A ∈ sets borel}" by simp
show "sigma_sets (space M) {?IA -` B ∩ space M |B. B ∈ sets borel} ⊆ sets N"
proof -
have "sigma_algebra (space M) (sets N)" using assms
by (metis subalgebra_indep_var_def sets.sigma_algebra_axioms subalgebra_def)
have "sigma_sets (space M) {?IA -` B ∩ space M |B. B ∈ sets borel} ⊆ sigma_sets (space M) (sets N)"
proof (rule sigma_sets_subseteq)
show "{?IA -` B ∩ space M |B. B ∈ sets borel} ⊆ sets N"
proof
fix x
assume "x ∈ {?IA -` B ∩ space M |B. B ∈ sets borel}"
then obtain B where "B ∈ sets borel" and "x = ?IA -` B ∩ space M" by auto
thus "x ∈ sets N"
by (metis (no_types, lifting) assms(1) assms(3) borel_measurable_indicator measurable_sets subalgebra_indep_var_def subalgebra_def)
qed
qed
also have "... = sets N"
by (simp add: ‹sigma_algebra (space M) (sets N)› sigma_algebra.sigma_sets_eq)
finally show "sigma_sets (space M) {?IA -` B ∩ space M |B. B ∈ sets borel} ⊆ sets N" .
qed
show "indep_set (sigma_sets (space M) {X -` A ∩ space M |A. A ∈ sets borel}) (sets N) "
using assms unfolding subalgebra_indep_var_def by simp
qed
qed
lemma fct_gen_subalgebra_cong:
assumes "space M = space P"
and "sets N = sets Q"
shows "fct_gen_subalgebra M N X = fct_gen_subalgebra P Q X"
proof -
have "space M = space P" using assms by simp
thus ?thesis using assms unfolding fct_gen_subalgebra_def gen_subalgebra_def by simp
qed
end
Theory Filtration
section ‹Filtrations›
text ‹This theory introduces basic notions about filtrations, which permit to define adaptable processes
and predictable processes in the case where the filtration is indexed by natural numbers.›
theory Filtration imports "HOL-Probability.Probability"
begin
subsection ‹Basic definitions›
class linorder_bot = linorder + bot
instantiation nat::linorder_bot
begin
instance proof qed
end
definition filtration :: "'a measure ⇒ ('i::linorder_bot ⇒ 'a measure) ⇒ bool" where
"filtration M F ⟷
(∀t. subalgebra M (F t)) ∧
(∀ s t. s ≤ t ⟶ subalgebra (F t) (F s))"
lemma filtrationI:
assumes "∀t. subalgebra M (F t)"
and "∀s t. s ≤ t ⟶ subalgebra (F t) (F s)"
shows "filtration M F" unfolding filtration_def using assms by simp
lemma filtrationE1:
assumes "filtration M F"
shows "subalgebra M (F t)" using assms unfolding filtration_def by simp
lemma filtrationE2:
assumes "filtration M F"
shows "s≤ t ⟹ subalgebra (F t) (F s)" using assms unfolding filtration_def by simp
locale filtrated_prob_space = prob_space +
fixes F
assumes filtration: "filtration M F"
lemma (in filtrated_prob_space) filtration_space:
assumes "s ≤ t"
shows "space (F s) = space (F t)" by (metis filtration filtration_def subalgebra_def)
lemma (in filtrated_prob_space) filtration_measurable:
assumes "f∈ measurable (F t) N"
shows "f∈ measurable M N" unfolding measurable_def
proof
show "f ∈ space M → space N ∧ (∀y∈sets N. f -` y ∩ space M ∈ sets M)"
proof (intro conjI ballI)
have "space (F t) = space M" using assms filtration unfolding filtration_def subalgebra_def by auto
thus "f∈ space M → space N" using assms unfolding measurable_def by simp
fix y
assume "y∈ sets N"
hence "f -`y∩ space M ∈ sets (F t)" using assms unfolding measurable_def
using ‹space (F t) = space M› by auto
thus "f -`y∩ space M ∈ sets M" using assms filtration unfolding filtration_def subalgebra_def by auto
qed
qed
lemma (in filtrated_prob_space) increasing_measurable_info:
assumes "f∈ measurable (F s) N"
and "s ≤ t"
shows "f∈ measurable (F t) N"
proof (rule measurableI)
have inc: "sets (F s) ⊆ sets (F t)"
using assms(2) filtration by (simp add: filtration_def subalgebra_def)
have sp: "space (F s) = space (F t)" by (metis filtration filtration_def subalgebra_def)
thus "⋀x. x ∈ space (F t) ⟹ f x ∈ space N" using assms by (simp add: measurable_space)
show "⋀A. A ∈ sets N ⟹ f -` A ∩ space (F t) ∈ sets (F t)"
proof -
fix A
assume "A∈ sets N"
hence "f -` A ∩ space (F s) ∈ sets (F s)" using assms using measurable_sets by blast
hence "f -` A ∩ space (F s) ∈ sets (F t)" using subsetD[of "F s" "F t"] inc by blast
thus "f -` A ∩ space (F t) ∈ sets (F t)" using sp by simp
qed
qed
definition disc_filtr :: "'a measure ⇒ (nat ⇒ 'a measure) ⇒ bool" where
"disc_filtr M F ⟷
(∀n. subalgebra M (F n)) ∧
(∀ n m. n ≤ m ⟶ subalgebra (F m) (F n))"
locale disc_filtr_prob_space = prob_space +
fixes F
assumes discrete_filtration: "disc_filtr M F"
lemma (in disc_filtr_prob_space) subalgebra_filtration:
assumes "subalgebra N M"
and "filtration M F"
shows "filtration N F"
proof (rule filtrationI)
show "∀s t. s ≤ t ⟶ subalgebra (F t) (F s)" using assms unfolding filtration_def by simp
show "∀t. subalgebra N (F t)"
proof
fix t
have "subalgebra M (F t)" using assms unfolding filtration_def by auto
thus "subalgebra N (F t)" using assms by (metis subalgebra_def subsetCE subsetI)
qed
qed
sublocale disc_filtr_prob_space ⊆ filtrated_prob_space
proof unfold_locales
show "filtration M F"
using discrete_filtration by (simp add: filtration_def disc_filtr_def)
qed
subsection ‹Stochastic processes›
text ‹Stochastic processes are collections of measurable functions. Those of a particular interest when
there is a filtration are the adapted stochastic processes.›
definition stoch_procs where
"stoch_procs M N = {X. ∀t. (X t) ∈ measurable M N}"
subsubsection ‹Adapted stochastic processes›
definition adapt_stoch_proc where
"(adapt_stoch_proc F X N) ⟷ (∀t. (X t) ∈ measurable (F t) N)"
abbreviation "borel_adapt_stoch_proc F X ≡ adapt_stoch_proc F X borel"
lemma (in filtrated_prob_space) adapted_is_dsp:
assumes "adapt_stoch_proc F X N"
shows "X ∈ stoch_procs M N"
unfolding stoch_procs_def
by (intro CollectI, (meson adapt_stoch_proc_def assms filtration filtration_def measurable_from_subalg))
lemma (in filtrated_prob_space) adapt_stoch_proc_borel_measurable:
assumes "adapt_stoch_proc F X N"
shows "∀n. (X n) ∈ measurable M N"
proof
fix n
have "X n ∈ measurable (F n) N" using assms unfolding adapt_stoch_proc_def by simp
moreover have "subalgebra M (F n)" using filtration unfolding filtration_def by simp
ultimately show "X n ∈ measurable M N" by (simp add:measurable_from_subalg)
qed
lemma (in filtrated_prob_space) borel_adapt_stoch_proc_borel_measurable:
assumes "borel_adapt_stoch_proc F X"
shows "∀n. (X n) ∈ borel_measurable M"
proof
fix n
have "X n ∈ borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
moreover have "subalgebra M (F n)" using filtration unfolding filtration_def by simp
ultimately show "X n ∈ borel_measurable M" by (simp add:measurable_from_subalg)
qed
lemma (in filtrated_prob_space) constant_process_borel_adapted:
shows "borel_adapt_stoch_proc F (λ n w. c)"
unfolding adapt_stoch_proc_def
proof
fix t
show "(λw. c) ∈ borel_measurable (F t)" using borel_measurable_const by blast
qed
lemma (in filtrated_prob_space) borel_adapt_stoch_proc_add:
fixes X::"'b ⇒ 'a ⇒ ('c::{second_countable_topology, topological_monoid_add})"
assumes "borel_adapt_stoch_proc F X"
and "borel_adapt_stoch_proc F Y"
shows "borel_adapt_stoch_proc F (λt w. X t w + Y t w)" unfolding adapt_stoch_proc_def
proof
fix t
have "X t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
moreover have "Y t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
ultimately show "(λw. X t w + Y t w) ∈ borel_measurable (F t)" by simp
qed
lemma (in filtrated_prob_space) borel_adapt_stoch_proc_sum:
fixes A::"'d ⇒ 'b ⇒ 'a ⇒ ('c::{second_countable_topology, topological_comm_monoid_add})"
assumes "⋀i. i∈ S ⟹ borel_adapt_stoch_proc F (A i)"
shows "borel_adapt_stoch_proc F (λ t w. (∑ i∈ S. A i t w))" unfolding adapt_stoch_proc_def
proof
fix t
have "⋀i. i∈ S⟹ A i t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
thus "(λ w. (∑ i∈ S. A i t w)) ∈ borel_measurable (F t)" by (simp add:borel_measurable_sum)
qed
lemma (in filtrated_prob_space) borel_adapt_stoch_proc_times:
fixes X::"'b ⇒ 'a ⇒ ('c::{second_countable_topology, real_normed_algebra})"
assumes "borel_adapt_stoch_proc F X"
and "borel_adapt_stoch_proc F Y"
shows "borel_adapt_stoch_proc F (λt w. X t w * Y t w)" unfolding adapt_stoch_proc_def
proof
fix t
have "X t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
moreover have "Y t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
ultimately show "(λw. X t w * Y t w) ∈ borel_measurable (F t)" by simp
qed
lemma (in filtrated_prob_space) borel_adapt_stoch_proc_prod:
fixes A::"'d ⇒ 'b ⇒ 'a ⇒ ('c::{second_countable_topology, real_normed_field})"
assumes "⋀i. i∈ S ⟹ borel_adapt_stoch_proc F (A i)"
shows "borel_adapt_stoch_proc F (λ t w. (∏ i∈ S. A i t w))" unfolding adapt_stoch_proc_def
proof
fix t
have "⋀i. i∈ S⟹ A i t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
thus "(λ w. (∏ i∈ S. A i t w)) ∈ borel_measurable (F t)" by simp
qed
subsubsection ‹Predictable stochastic processes›
definition predict_stoch_proc where
"(predict_stoch_proc F X N) ⟷ (X 0 ∈ measurable (F 0) N ∧ (∀n. (X (Suc n)) ∈ measurable (F n) N))"
abbreviation "borel_predict_stoch_proc F X ≡ predict_stoch_proc F X borel"
lemma (in disc_filtr_prob_space) predict_imp_adapt:
assumes "predict_stoch_proc F X N"
shows "adapt_stoch_proc F X N" unfolding adapt_stoch_proc_def
proof
fix n
show "X n ∈ measurable (F n) N"
proof (cases "n = 0")
case True
thus ?thesis using assms unfolding predict_stoch_proc_def by auto
next
case False
thus ?thesis using assms unfolding predict_stoch_proc_def
by (metis Suc_n_not_le_n increasing_measurable_info nat_le_linear not0_implies_Suc)
qed
qed
lemma (in disc_filtr_prob_space) predictable_is_dsp:
assumes "predict_stoch_proc F X N"
shows "X ∈ stoch_procs M N"
unfolding stoch_procs_def
proof
show "∀n. random_variable N (X n)"
proof
fix n
show "random_variable N (X n)"
proof (cases "n=0")
case True
thus ?thesis using assms unfolding predict_stoch_proc_def
using filtration filtration_def measurable_from_subalg by blast
next
case False
thus ?thesis using assms unfolding predict_stoch_proc_def
by (metis filtration filtration_def measurable_from_subalg not0_implies_Suc)
qed
qed
qed
lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_borel_measurable:
assumes "borel_predict_stoch_proc F X"
shows "∀n. (X n) ∈ borel_measurable M" using assms predictable_is_dsp unfolding stoch_procs_def by auto
lemma (in disc_filtr_prob_space) constant_process_borel_predictable:
shows "borel_predict_stoch_proc F (λ n w. c)"
unfolding predict_stoch_proc_def
proof
show "(λw. c) ∈ borel_measurable (F 0)" using borel_measurable_const by blast
next
show "∀n. (λw. c) ∈ borel_measurable (F n)" using borel_measurable_const by blast
qed
lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_add:
fixes X::"nat ⇒ 'a ⇒ ('c::{second_countable_topology, topological_monoid_add})"
assumes "borel_predict_stoch_proc F X"
and "borel_predict_stoch_proc F Y"
shows "borel_predict_stoch_proc F (λt w. X t w + Y t w)" unfolding predict_stoch_proc_def
proof
show "(λw. X 0 w + Y 0 w) ∈ borel_measurable (F 0)"
using assms(1) assms(2) borel_measurable_add predict_stoch_proc_def by blast
next
show "∀n. (λw. X (Suc n) w + Y (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "X (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
moreover have "Y (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
ultimately show "(λw. X (Suc n) w + Y (Suc n) w) ∈ borel_measurable (F n)" by simp
qed
qed
lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_sum:
fixes A::"'d ⇒ nat ⇒ 'a ⇒ ('c::{second_countable_topology, topological_comm_monoid_add})"
assumes "⋀i. i∈ S ⟹ borel_predict_stoch_proc F (A i)"
shows "borel_predict_stoch_proc F (λ t w. (∑ i∈ S. A i t w))" unfolding predict_stoch_proc_def
proof
show "(λw. ∑i∈S. A i 0 w) ∈ borel_measurable (F 0)"
proof
have "⋀i. i∈ S⟹ A i 0 ∈ borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
thus "(λ w. (∑ i∈ S. A i 0 w)) ∈ borel_measurable (F 0)" by (simp add:borel_measurable_sum)
qed simp
next
show "∀n. (λw. ∑i∈S. A i (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "⋀i. i∈ S⟹ A i (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
thus "(λ w. (∑ i∈ S. A i (Suc n) w)) ∈ borel_measurable (F n)" by (simp add:borel_measurable_sum)
qed
qed
lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_times:
fixes X::"nat ⇒ 'a ⇒ ('c::{second_countable_topology, real_normed_algebra})"
assumes "borel_predict_stoch_proc F X"
and "borel_predict_stoch_proc F Y"
shows "borel_predict_stoch_proc F (λt w. X t w * Y t w)" unfolding predict_stoch_proc_def
proof
show "(λw. X 0 w * Y 0 w) ∈ borel_measurable (F 0)"
proof -
have "X 0 ∈ borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
moreover have "Y 0 ∈ borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
ultimately show "(λw. X 0 w * Y 0 w) ∈ borel_measurable (F 0)" by simp
qed
next
show "∀n. (λw. X (Suc n) w * Y (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "X (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
moreover have "Y (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
ultimately show "(λw. X (Suc n) w * Y (Suc n) w) ∈ borel_measurable (F n)" by simp
qed
qed
lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_prod:
fixes A::"'d ⇒ nat ⇒ 'a ⇒ ('c::{second_countable_topology, real_normed_field})"
assumes "⋀i. i∈ S ⟹ borel_predict_stoch_proc F (A i)"
shows "borel_predict_stoch_proc F (λ t w. (∏ i∈ S. A i t w))" unfolding predict_stoch_proc_def
proof
show "(λw. ∏i∈S. A i 0 w) ∈ borel_measurable (F 0)"
proof -
have "⋀i. i∈ S⟹ A i 0 ∈ borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
thus "(λ w. (∏ i∈ S. A i 0 w)) ∈ borel_measurable (F 0)" by simp
qed
next
show "∀n. (λw. ∏i∈S. A i (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "⋀i. i∈ S⟹ A i (Suc n) ∈ borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
thus "(λ w. (∏ i∈ S. A i (Suc n) w)) ∈ borel_measurable (F n)" by simp
qed
qed
definition (in prob_space) constant_image where
"constant_image f = (if ∃ c::'b::{t2_space}. ∀x∈ space M. f x = c then
SOME c. ∀x ∈ space M. f x = c else undefined)"
lemma (in prob_space) constant_imageI:
assumes "∃c::'b::{t2_space}. ∀x∈ space M. f x = c"
shows "∀x∈ space M. f x = (constant_image f)"
proof
fix x
assume "x∈ space M"
let ?c = "SOME c. ∀x∈ space M. f x = c"
have "f x = ?c" using ‹x∈ space M› someI_ex[of "λc. ∀x∈ space M. f x = c"] assms by blast
thus "f x = (constant_image f)" by (simp add: assms prob_space.constant_image_def prob_space_axioms)
qed
lemma (in prob_space) constant_image_pos:
assumes "∀x∈ space M. (0::real) < f x"
and "∃c::real. ∀x∈ space M. f x = c"
shows "0 < (constant_image f)"
proof -
{
fix x
assume "x∈ space M"
hence "0 < f x" using assms by simp
also have "... = constant_image f" using assms constant_imageI ‹x∈ space M› by auto
finally have ?thesis .
}
thus ?thesis using subprob_not_empty by auto
qed
definition open_except where
"open_except x y = (if x = y then {} else SOME A. open A ∧ x∈ A ∧ y∉ A)"
lemma open_exceptI:
assumes "(x::'b::{t1_space}) ≠ y"
shows "open (open_except x y)" and "x∈ open_except x y" and "y∉ open_except x y"
proof-
have ex:"∃U. open U ∧ x ∈ U ∧ y ∉ U" using ‹x≠ y› by (simp add:t1_space)
let ?V = "SOME A. open A ∧ x∈ A ∧ y∉ A"
have vprop: "open ?V ∧ x ∈ ?V ∧ y ∉ ?V" using someI_ex[of "λU. open U ∧ x ∈ U ∧ y ∉ U"] ex by blast
show "open (open_except x y)" by (simp add: open_except_def vprop)
show "x∈ open_except x y" by (metis (full_types) open_except_def vprop)
show "y∉ open_except x y" by (metis (full_types) open_except_def vprop)
qed
lemma open_except_set:
assumes "finite A"
and "(x::'b::{t1_space}) ∉ A"
shows "∃U. open U ∧ x∈ U ∧ U∩ A = {}"
proof(intro exI conjI)
have "∀y∈ A. x≠ y" using assms by auto
let ?U = "⋂ y ∈ A. open_except x y"
show "open ?U"
proof (intro open_INT ballI, (simp add: assms))
fix y
assume "y∈ A"
show "open (open_except x y)" using ‹∀y∈ A. x≠ y› by (simp add: ‹y ∈ A› open_exceptI)
qed
show "x ∈ (⋂y∈A. open_except x y)"
proof
fix y
assume "y∈ A"
show "x∈open_except x y" using ‹∀y∈ A. x≠ y› by (simp add: ‹y ∈ A› open_exceptI)
qed
have "∀y∈A. y∉ ?U" using ‹∀y∈ A. x≠ y› open_exceptI(3) by auto
thus "(⋂y∈A. open_except x y) ∩ A = {}" by auto
qed
definition open_exclude_set where
"open_exclude_set x A = (if (∃U. open U ∧ U∩ A = {x}) then SOME U. open U ∧ U ∩ A = {x} else {})"
lemma open_exclude_setI:
assumes "∃U. open U ∧ U∩ A = {x}"
shows "open (open_exclude_set x A)" and "(open_exclude_set x A) ∩ A = {x}"
proof -
let ?V = "SOME U. open U ∧ U ∩ A = {x}"
have vprop: "open ?V ∧ ?V ∩ A = {x}" using someI_ex[of "λU. open U ∧ U ∩ A = {x}"] assms by blast
show "open (open_exclude_set x A)" by (simp add: open_exclude_set_def vprop)
show "open_exclude_set x A ∩ A = {x}" by (metis (mono_tags, lifting) open_exclude_set_def vprop)
qed
lemma open_exclude_finite:
assumes "finite A"
and "(x::'b::{t1_space})∈ A"
shows open_set: "open (open_exclude_set x A)" and inter_x:"(open_exclude_set x A) ∩ A = {x}"
proof -
have "∃U. open U ∧ U∩ A = {x}"
proof -
have "∃U. open U ∧ x∈ U ∧ U∩ (A-{x}) = {}"
proof (rule open_except_set)
show "finite (A -{x})" using assms by auto
show "x∉ A -{x}" by simp
qed
thus ?thesis using assms by auto
qed
thus "open (open_exclude_set x A)" and "(open_exclude_set x A) ∩ A = {x}" by (auto simp add: open_exclude_setI)
qed
subsection ‹Initially trivial filtrations›
text ‹Intuitively, these are filtrations that can be used to denote the fact that there is no information at the start.›
definition init_triv_filt::"'a measure ⇒ ('i::linorder_bot ⇒ 'a measure) ⇒ bool" where
"init_triv_filt M F ⟷ filtration M F ∧ sets (F bot) = {{}, space M}"
lemma triv_measurable_cst:
fixes f::"'a⇒'b::{t2_space}"
assumes "space N = space M"
and "space M ≠ {}"
and "sets N = {{}, space M}"
and "f∈ measurable N borel"
shows "∃ c::'b. ∀x∈ space N. f x = c"
proof -
have "f `(space N) ≠ {}" using assms by (simp add: assms)
hence "∃ c. c∈ f`(space N)" by auto
from this obtain c where "c∈ f`(space N)" by auto
have "∀x ∈ space N. f x = c"
proof
fix x
assume "x∈ space N"
show "f x = c"
proof (rule ccontr)
assume "f x ≠ c"
hence "(∃U V. open U ∧ open V ∧ (f x) ∈ U ∧ c ∈ V ∧ U ∩ V = {})" by (simp add: separation_t2)
from this obtain U and V where "open U" and "open V" and "(f x) ∈ U" and "c ∈ V" and "U ∩ V = {}" by blast
have "(f -`V) ∩ space N = space N"
proof -
have "V∈ sets borel" using ‹open V› unfolding borel_def by simp
hence "(f -`V) ∩ space N ∈ sets N" using assms unfolding measurable_def by simp
show "(f -`V) ∩ space N = space N"
proof (rule ccontr)
assume "(f -`V) ∩ space N ≠ space N"
hence "(f -`V) ∩ space N = {}" using assms ‹(f -`V) ∩ space N ∈ sets N› by simp
thus False using ‹c∈V› using ‹c ∈ f ` space N› by blast
qed
qed
have "((f-`U)∩ space N) ∩ ((f-`V) ∩ space N) = {}" using ‹U∩V = {}› by auto
moreover have "(f -`U) ∩ space N ∈ sets N" using assms ‹open U› unfolding measurable_def by simp
ultimately have "(f -`U) ∩ space N = {}" using assms ‹(f -`V) ∩ space N = space N› by simp
thus False using ‹f x ∈ U› ‹x ∈ space N› by blast
qed
qed
thus "∃ c. ∀x∈ space N. f x = c" by auto
qed
locale trivial_init_filtrated_prob_space = prob_space +
fixes F
assumes info_filtration: "init_triv_filt M F"
sublocale trivial_init_filtrated_prob_space ⊆ filtrated_prob_space
using info_filtration unfolding init_triv_filt_def by (unfold_locales, simp)
locale triv_init_disc_filtr_prob_space = prob_space +
fixes F
assumes info_disc_filtr: "disc_filtr M F ∧ sets (F bot) = {{}, space M}"
sublocale triv_init_disc_filtr_prob_space ⊆ trivial_init_filtrated_prob_space
proof unfold_locales
show "init_triv_filt M F" using info_disc_filtr bot_nat_def unfolding init_triv_filt_def disc_filtr_def
by (simp add: filtrationI)
qed
sublocale triv_init_disc_filtr_prob_space ⊆ disc_filtr_prob_space
proof unfold_locales
show "disc_filtr M F" using info_disc_filtr by simp
qed
lemma (in triv_init_disc_filtr_prob_space) adapted_init:
assumes "borel_adapt_stoch_proc F x"
shows "∃c. ∀w ∈ space M. ((x 0 w)::real) = c"
proof -
have "space M = space (F 0)" using filtration
by (simp add: filtration_def subalgebra_def)
moreover have "∃c. ∀w ∈ space (F 0). x 0 w = c"
proof (rule triv_measurable_cst)
show "space (F 0) = space M" using ‹space M = space (F 0)› ..
show "sets (F 0) = {{}, space M}" using info_disc_filtr
by (simp add: init_triv_filt_def bot_nat_def)
show "x 0 ∈ borel_measurable (F 0)" using assms by (simp add: adapt_stoch_proc_def)
show "space M ≠ {}" by (simp add:not_empty)
qed
ultimately show ?thesis by simp
qed
subsection ‹Filtration-equivalent measure spaces›
text ‹This is a relaxation of the notion of equivalent probability spaces, where equivalence is tested modulo a
filtration. Equivalent measure spaces agree on events that have a zero probability of occurring; here, filtration-equivalent
measure spaces agree on such events when they belong to the filtration under consideration.›
definition filt_equiv where
"filt_equiv F M N ⟷ sets M = sets N ∧ filtration M F ∧ (∀ t A. A ∈ sets (F t) ⟶ (emeasure M A = 0) ⟷ (emeasure N A = 0))"
lemma filt_equiv_space:
assumes "filt_equiv F M N"
shows "space M = space N" using assms unfolding filt_equiv_def
filtration_def subalgebra_def by (meson sets_eq_imp_space_eq)
lemma filt_equiv_sets:
assumes "filt_equiv F M N"
shows "sets M = sets N" using assms unfolding filt_equiv_def by simp
lemma filt_equiv_filtration:
assumes "filt_equiv F M N"
shows "filtration N F" using assms unfolding filt_equiv_def filtration_def subalgebra_def
by (metis sets_eq_imp_space_eq)
lemma (in filtrated_prob_space) AE_borel_eq:
fixes f::"'a⇒real"
assumes "f∈ borel_measurable (F t)"
and "g∈ borel_measurable (F t)"
and "AE w in M. f w = g w"
shows "{w∈ space M. f w ≠ g w} ∈ sets (F t) ∧ emeasure M {w∈ space M. f w ≠ g w} = 0"
proof
show "{w ∈ space M. f w ≠ g w} ∈ sets (F t)"
proof -
define minus where "minus = (λw. (f w) - (g w))"
have "minus ∈ borel_measurable (F t)" unfolding minus_def using assms by simp
hence "{w∈ space (F t). 0 < minus w} ∈ sets (F t)" using borel_measurable_iff_greater by auto
moreover have "{w∈ space (F t). minus w < 0} ∈ sets (F t)" using borel_measurable_iff_less
‹minus ∈ borel_measurable (F t)› by auto
ultimately have "{w∈ space (F t). 0 < minus w} ∪ {w∈ space (F t). minus w < 0} ∈ sets (F t)" by simp
moreover have "{w∈ space (F t). f w ≠ g w} = {w∈ space (F t). 0 < minus w} ∪ {w∈ space (F t). minus w < 0}"
proof
show "{w ∈ space (F t). f w ≠ g w} ⊆ {w ∈ space (F t). 0 < minus w} ∪ {w ∈ space (F t). minus w < 0}"
proof
fix w
assume "w ∈ {w ∈ space (F t). f w ≠ g w}"
hence "w∈ space (F t)" and "f w ≠ g w" by auto
thus "w∈ {w ∈ space (F t). 0 < minus w} ∪ {w ∈ space (F t). minus w < 0}" unfolding minus_def
by (cases "f w < g w") auto
qed
have "{w ∈ space (F t). 0 < minus w} ⊆ {w ∈ space (F t). f w ≠ g w}" unfolding minus_def by auto
moreover have "{w ∈ space (F t). minus w < 0} ⊆ {w ∈ space (F t). f w ≠ g w}" unfolding minus_def by auto
ultimately show "{w ∈ space (F t). 0 < minus w} ∪ {w ∈ space (F t). minus w < 0} ⊆ {w ∈ space (F t). f w ≠ g w}"
by simp
qed
moreover have "space (F t) = space M" using filtration unfolding filtration_def subalgebra_def by simp
ultimately show ?thesis by simp
qed
show "emeasure M {w∈ space M. f w ≠ g w} = 0" by (metis (no_types) AE_iff_measurable assms(3) emeasure_notin_sets)
qed
lemma (in prob_space) filt_equiv_borel_AE_eq:
fixes f::"'a⇒ real"
assumes "filt_equiv F M N"
and "f∈ borel_measurable (F t)"
and "g∈ borel_measurable (F t)"
and "AE w in M. f w = g w"
shows "AE w in N. f w = g w"
proof -
have set0: "{w∈ space M. f w ≠ g w} ∈ sets (F t) ∧ emeasure M {w∈ space M. f w ≠ g w} = 0"
proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
show "filtrated_prob_space M F" using assms unfolding filt_equiv_def
by (simp add: filtrated_prob_space_axioms.intro filtrated_prob_space_def prob_space_axioms)
qed
hence "emeasure N {w∈ space M. f w ≠ g w} = 0" using assms unfolding filt_equiv_def by auto
moreover have "{w∈ space M. f w ≠ g w} ∈ sets N" using set0 assms unfolding filt_equiv_def
filtration_def subalgebra_def by auto
ultimately show ?thesis
proof -
have "space M = space N"
by (metis assms(1) filt_equiv_space)
then have "∀p. almost_everywhere N p ∨ {a ∈ space N. ¬ p a} ≠ {a ∈ space N. f a ≠ g a}"
using AE_iff_measurable ‹emeasure N {w ∈ space M. f w ≠ g w} = 0› ‹{w ∈ space M. f w ≠ g w} ∈ sets N›
by auto
then show ?thesis
by metis
qed
qed
lemma filt_equiv_prob_space_subalgebra:
assumes "prob_space N"
and "filt_equiv F M N"
and "sigma_finite_subalgebra M G"
shows "sigma_finite_subalgebra N G" unfolding sigma_finite_subalgebra_def
proof
show "subalgebra N G"
by (metis assms(2) assms(3) filt_equiv_space filt_equiv_def sigma_finite_subalgebra_def subalgebra_def)
show "sigma_finite_measure (restr_to_subalg N G)" unfolding restr_to_subalg_def
by (metis ‹subalgebra N G› assms(1) finite_measure_def finite_measure_restr_to_subalg prob_space_def restr_to_subalg_def)
qed
lemma filt_equiv_measurable:
assumes "filt_equiv F M N"
and "f∈ measurable M P"
shows "f∈ measurable N P" using assms unfolding filt_equiv_def measurable_def
proof -
assume a1: "sets M = sets N ∧ Filtration.filtration M F ∧ (∀t A. A ∈ sets (F t) ⟶ (emeasure M A = 0) = (emeasure N A = 0))"
assume a2: "f ∈ {f ∈ space M → space P. ∀y∈sets P. f -` y ∩ space M ∈ sets M}"
have "space N = space M"
using a1 by (metis (lifting) sets_eq_imp_space_eq)
then show "f ∈ {f ∈ space N → space P. ∀C∈sets P. f -` C ∩ space N ∈ sets N}"
using a2 a1 by force
qed
lemma filt_equiv_imp_subalgebra:
assumes "filt_equiv F M N"
shows "subalgebra N M" unfolding subalgebra_def
using assms filt_equiv_space filt_equiv_def by blast
end
Theory Martingale
section ‹Martingales›
theory Martingale imports Filtration
begin
definition martingale where
"martingale M F X ⟷
(filtration M F) ∧ (∀t. integrable M (X t)) ∧ (borel_adapt_stoch_proc F X) ∧
(∀t s. t ≤ s ⟶ (AE w in M. real_cond_exp M (F t) (X s) w = X t w))"
lemma martingaleAE:
assumes "martingale M F X"
and "t ≤ s"
shows "AE w in M. real_cond_exp M (F t) (X s) w = (X t) w" using assms unfolding martingale_def by simp
lemma martingale_add:
assumes "martingale M F X"
and "martingale M F Y"
and "∀m. sigma_finite_subalgebra M (F m)"
shows "martingale M F (λn w. X n w + Y n w)" unfolding martingale_def
proof (intro conjI)
let ?sum = "λn w. X n w + Y n w"
show "∀n. integrable M (λw. X n w + Y n w)"
proof
fix n
show "integrable M (λw. X n w + Y n w)"
by (metis Bochner_Integration.integrable_add assms(1) assms(2) martingale_def)
qed
show "∀n m. n ≤ m ⟶ (AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w = X n w + Y n w)"
proof (intro allI impI)
fix n::'b
fix m
assume "n ≤ m"
show "AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w = X n w + Y n w"
proof -
have "integrable M (X m)" using assms unfolding martingale_def by simp
moreover have "integrable M (Y m)" using assms unfolding martingale_def by simp
moreover have " sigma_finite_subalgebra M (F n)" using assms by simp
ultimately have "AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w =
real_cond_exp M (F n) (X m) w + real_cond_exp M (F n) (Y m) w"
using sigma_finite_subalgebra.real_cond_exp_add[of M "F n" "X m" "Y m"] by simp
moreover have "AE w in M. real_cond_exp M (F n) (X m) w = X n w" using ‹n≤ m› assms
unfolding martingale_def by simp
moreover have "AE w in M. real_cond_exp M (F n) (Y m) w = Y n w" using ‹n≤ m› assms
unfolding martingale_def by simp
ultimately show ?thesis by auto
qed
qed
show "filtration M F" using assms unfolding martingale_def by simp
show "borel_adapt_stoch_proc F (λn w. X n w + Y n w)" unfolding adapt_stoch_proc_def
proof
fix n
show "(λw. X n w + Y n w) ∈ borel_measurable (F n)" using assms unfolding martingale_def adapt_stoch_proc_def
by (simp add: borel_measurable_add)
qed
qed
lemma disc_martingale_charact:
assumes "(∀n. integrable M (X n))"
and "filtration M F"
and "∀m. sigma_finite_subalgebra M (F m)"
and "∀m. X m ∈ borel_measurable (F m)"
and "(∀n. AE w in M. real_cond_exp M (F n) (X (Suc n)) w = (X n) w)"
shows "martingale M F X " unfolding martingale_def
proof (intro conjI)
have "∀ k m. k ≤ m ⟶ (AE w in M. real_cond_exp M (F (m-k)) (X m) w = X (m-k) w)"
proof (intro allI impI)
fix m
fix k::nat
show "k≤m ⟹ AE w in M. real_cond_exp M (F (m-k)) (X m) w = X (m-k) w"
proof (induct k)
case 0
have "X m ∈ borel_measurable (F m)" using assms by simp
moreover have "integrable M (X m)" using assms by simp
moreover have "sigma_finite_subalgebra M (F m)" using assms by simp
ultimately have "AE w in M. real_cond_exp M (F m) (X m) w = X m w"
using sigma_finite_subalgebra.real_cond_exp_F_meas[of M "F m" "X m"] by simp
thus ?case using 0 by simp
next
case (Suc k)
have "Suc (m - (Suc k)) = m - k" using Suc by simp
hence "AE w in M. real_cond_exp M (F (m - (Suc k))) (X (Suc (m - (Suc k)))) w = (X (m - (Suc k))) w"
using assms by blast
hence "AE w in M. real_cond_exp M (F (m - (Suc k))) (X ((m - k))) w = (X (m - (Suc k))) w"
using assms(3) ‹Suc (m - (Suc k)) = m - k› by simp
moreover have "AE w in M. real_cond_exp M (F (m - (Suc k))) (real_cond_exp M (F (m - k)) (X m)) w =
real_cond_exp M (F (m - (Suc k))) (X m) w"
using sigma_finite_subalgebra.real_cond_exp_nested_subalg[of M "F (m- (Suc k))" "F (m-k)" "X m"]
by (metis Filtration.filtration_def Suc_n_not_le_n ‹Suc (m - Suc k) = m - k› assms(1) assms(2) assms(3)
filtrationE1 nat_le_linear)
moreover have "AE w in M. real_cond_exp M (F (m - (Suc k))) (real_cond_exp M (F (m - k)) (X m)) w =
real_cond_exp M (F (m - (Suc k))) (X (m-k)) w" using Suc
sigma_finite_subalgebra.real_cond_exp_cong[of M "F (m - (Suc k))" "real_cond_exp M (F (m - k)) (X m)" "X (m - k)"]
borel_measurable_cond_exp[of M "F (m-k)" "X m"]
using Suc_leD assms(1) assms(3) borel_measurable_cond_exp2 by blast
ultimately show ?case by auto
qed
qed
thus "∀ n m. n ≤ m ⟶ (AE w in M. real_cond_exp M (F n) (X m) w = X n w)"
by (metis diff_diff_cancel diff_le_self)
show "∀t. integrable M (X t)" using assms by simp
show "filtration M F" using assms by simp
show "borel_adapt_stoch_proc F X" using assms unfolding adapt_stoch_proc_def by simp
qed
lemma (in finite_measure) constant_martingale:
assumes "∀t. sigma_finite_subalgebra M (F t)"
and "filtration M F"
shows "martingale M F (λn w. c)" unfolding martingale_def
proof (intro allI conjI impI)
show "filtration M F" using assms by simp
{
fix t
show "integrable M (λw. c)" by simp
}
{
fix t::'b
fix s
assume "t ≤ s"
show "AE w in M. real_cond_exp M (F t) (λw. c) w = c"
by (intro sigma_finite_subalgebra.real_cond_exp_F_meas, (auto simp add: assms))
}
show "borel_adapt_stoch_proc F (λn w. c)" unfolding adapt_stoch_proc_def by simp
qed
end
Theory Disc_Cond_Expect
section ‹Discrete Conditional Expectation›
theory Disc_Cond_Expect imports "HOL-Probability.Probability" Generated_Subalgebra
begin
subsection ‹Preliminary measurability results›
text ‹These are some useful results, in particular when working with functions that have a countable
codomain.›
definition disc_fct where
"disc_fct f ≡ countable (range f)"
definition point_measurable where
"point_measurable M S f ≡ (f`(space M)⊆ S) ∧ (∀ r ∈ (range f) ∩ S . f-`{r} ∩ (space M) ∈ sets M)"
lemma singl_meas_if:
assumes "f ∈ space M → space N"
and "∀r∈ range f∩ space N. ∃A∈ sets N. range f∩ A = {r}"
shows "point_measurable (fct_gen_subalgebra M N f) (space N) f" unfolding point_measurable_def
proof
show "f`space (fct_gen_subalgebra M N f)⊆ space N" using assms
by (simp add: Pi_iff fct_gen_subalgebra_space image_subsetI)
show "(∀r∈range f ∩ space N. f -` {r} ∩ space (fct_gen_subalgebra M N f) ∈ sets (fct_gen_subalgebra M N f))"
proof
fix r
assume "r∈ range f ∩ space N"
hence "∃A∈ sets N. range f∩ A = {r}" using assms by blast
from this obtain A where "A∈ sets N" and "range f ∩ A = {r}" by auto note Aprops = this
hence "f-`A = f-`{r}" by auto
hence "f-`A ∩ space M = f-`{r} ∩ space (fct_gen_subalgebra M N f)" by (simp add: fct_gen_subalgebra_space)
thus "f -` {r} ∩ space (fct_gen_subalgebra M N f) ∈ sets (fct_gen_subalgebra M N f)"
using Aprops fct_gen_subalgebra_sets_mem[of A N f M] by simp
qed
qed
lemma meas_single_meas:
assumes "f∈ measurable M N"
and "∀r∈ range f∩ space N. ∃A∈ sets N. range f∩ A = {r}"
shows "point_measurable M (space N) f"
proof -
have "subalgebra M (fct_gen_subalgebra M N f) " using assms fct_gen_subalgebra_is_subalgebra by blast
hence "sets (fct_gen_subalgebra M N f) ⊆ sets M" by (simp add: subalgebra_def)
moreover have "point_measurable (fct_gen_subalgebra M N f) (space N) f" using assms singl_meas_if
by (metis (no_types, lifting) Pi_iff measurable_space)
ultimately show ?thesis
proof -
obtain bb :: "'a measure ⇒ 'b set ⇒ ('a ⇒ 'b) ⇒ 'b" where
f1: "∀m B f. (¬ point_measurable m B f ∨ f ` space m ⊆ B ∧ (∀b. b ∉ range f ∩ B ∨ f -` {b} ∩ space m ∈ sets m)) ∧ (¬ f ` space m ⊆ B ∨ bb m B f ∈ range f ∩ B ∧ f -` {bb m B f} ∩ space m ∉ sets m ∨ point_measurable m B f)"
by (metis (no_types) point_measurable_def)
moreover
{ assume "f -` {bb M (space N) f} ∩ space (fct_gen_subalgebra M N f) ∈ sets (fct_gen_subalgebra M N f)"
then have "f -` {bb M (space N) f} ∩ space M ∈ sets (fct_gen_subalgebra M N f)"
by (metis ‹subalgebra M (fct_gen_subalgebra M N f)› subalgebra_def)
then have "f -` {bb M (space N) f} ∩ space M ∈ sets M"
using ‹sets (fct_gen_subalgebra M N f) ⊆ sets M› by blast
then have "f ` space M ⊆ space N ∧ f -` {bb M (space N) f} ∩ space M ∈ sets M"
using f1 by (metis ‹point_measurable (fct_gen_subalgebra M N f) (space N) f› ‹subalgebra M (fct_gen_subalgebra M N f)› subalgebra_def)
then have ?thesis
using f1 by metis }
ultimately show ?thesis
by (metis (no_types) ‹point_measurable (fct_gen_subalgebra M N f) (space N) f› ‹subalgebra M (fct_gen_subalgebra M N f)› subalgebra_def)
qed
qed
definition countable_preimages where
"countable_preimages B Y = (λn. if ((infinite B) ∨ (finite B ∧ n < card B)) then Y -` {(from_nat_into B) n} else {})"
lemma count_pre_disj:
fixes i::nat
assumes "countable B"
and "i ≠ j"
shows "(countable_preimages B Y) i ∩ (countable_preimages B Y) j = {}"
proof (cases "(countable_preimages B Y) i = {} ∨ (countable_preimages B Y) j = {}")
case True
thus ?thesis by auto
next
case False
hence "Y -` {(from_nat_into B) i} ≠ {} ∧ Y -` {(from_nat_into B) j} ≠ {}" unfolding countable_preimages_def by meson
have "(infinite B) ∨ (finite B ∧ i < card B ∧ j < card B)" using False unfolding countable_preimages_def
by meson
have "(from_nat_into B) i ≠ (from_nat_into B) j"
by (metis False assms(1) assms(2) bij_betw_def countable_preimages_def from_nat_into_inj from_nat_into_inj_infinite lessThan_iff to_nat_on_finite)
thus ?thesis
proof -
have f1: "∀A f n. if infinite A ∨ finite A ∧ n < card A then countable_preimages A f n = f -` {from_nat_into A n::'a} else countable_preimages A f n = ({}::'b set)"
by (meson countable_preimages_def)
then have f2: "infinite B ∨ finite B ∧ i < card B"
by (metis (no_types) False)
have "infinite B ∨ finite B ∧ j < card B"
using f1 by (meson False)
then show ?thesis
using f2 f1 ‹from_nat_into B i ≠ from_nat_into B j› by fastforce
qed
qed
lemma count_pre_surj:
assumes "countable B"
and "w ∈ Y -`B"
shows "∃i. w ∈ (countable_preimages B Y) i"
proof (cases "finite B")
case True
have "∃ i < card B. (from_nat_into B) i = Y w"
by (metis True assms(1) assms(2) bij_betw_def from_nat_into_to_nat_on image_eqI lessThan_iff
to_nat_on_finite vimageE)
from this obtain i where "i< card B" and "(from_nat_into B) i = Y w" by blast
hence "w ∈ (countable_preimages B Y) i"
by (simp add: countable_preimages_def)
thus "∃i. w ∈ (countable_preimages B Y) i" by auto
next
case False
hence "∃ i. (from_nat_into B) i = Y w"
by (meson assms(1) assms(2) from_nat_into_to_nat_on vimageE)
from this obtain i where "(from_nat_into B) i = Y w" by blast
hence "w ∈ (countable_preimages B Y) i"
by (simp add: False countable_preimages_def)
thus "∃i. w ∈ (countable_preimages B Y) i" by auto
qed
lemma count_pre_img:
assumes "x ∈ (countable_preimages B Y) n"
shows "Y x = (from_nat_into B) n"
proof -
have "x∈ Y -` {(from_nat_into B) n}" using assms unfolding countable_preimages_def
by (meson empty_iff)
thus ?thesis by simp
qed
lemma count_pre_union_img:
assumes "countable B"
shows "Y -`B = (⋃ i. (countable_preimages B Y) i)"
proof (cases "B = {}")
case False
have "Y -`B ⊆ (⋃ i. (countable_preimages B Y) i)"
by (simp add: assms count_pre_surj subset_eq)
moreover have "(⋃ i. (countable_preimages B Y) i) ⊆ Y -`B"
proof -
have f1: "∀b A f n. (b::'b) ∉ countable_preimages A f n ∨ (f b::'a) = from_nat_into A n"
by (meson count_pre_img)
have "range (from_nat_into B) = B"
by (meson False assms range_from_nat_into)
then show ?thesis
using f1 by blast
qed
ultimately show ?thesis by simp
next
case True
hence "∀ i. (countable_preimages B Y) i = {}" unfolding countable_preimages_def by simp
hence "(⋃ i. (countable_preimages B Y) i) = {}" by auto
moreover have "Y -`B = {}" using True by simp
ultimately show ?thesis by simp
qed
lemma count_pre_meas:
assumes "point_measurable M (space N) Y"
and "B⊆ space N"
and "countable B"
shows "∀i. (countable_preimages B Y) i ∩ space M ∈ sets M"
proof
fix i
have "Y -`B = (⋃ i. (countable_preimages B Y) i)" using assms
by (simp add: count_pre_union_img)
show "countable_preimages B Y i ∩ space M ∈ sets M"
proof (cases "countable_preimages B Y i = {}")
case True
thus ?thesis by simp
next
case False
from this obtain y where "y ∈ countable_preimages B Y i" by auto
hence "countable_preimages B Y i = Y -`{Y y}"
by (metis False count_pre_img countable_preimages_def)
have "Y y = from_nat_into B i"
by (meson ‹y ∈ countable_preimages B Y i› count_pre_img)
hence "Y y ∈ space N"
by (metis UNIV_I UN_I ‹y ∈ countable_preimages B Y i› ‹Y -`B = (⋃ i. (countable_preimages B Y) i)› assms(2) empty_iff from_nat_into subsetCE vimage_empty)
moreover have "Y y ∈ range Y" by simp
thus ?thesis
by (metis IntI ‹countable_preimages B Y i = Y -` {Y y}› assms(1) calculation point_measurable_def)
qed
qed
lemma disct_fct_point_measurable:
assumes "disc_fct f"
and "point_measurable M (space N) f"
shows "f∈ measurable M N" unfolding measurable_def
proof
show "f ∈ space M → space N ∧ (∀y∈sets N. f -` y ∩ space M ∈ sets M)"
proof
show "f ∈ space M → space N" using assms unfolding point_measurable_def by auto
show "∀y∈sets N. f -` y ∩ space M ∈ sets M"
proof
fix y
assume "y∈ sets N"
let ?imY = "range f ∩ y"
have "f-`y = f-`?imY" by auto
moreover have "countable ?imY" using assms unfolding disc_fct_def by auto
ultimately have "f -`y = (⋃ i. (countable_preimages ?imY f) i)" using assms count_pre_union_img by metis
hence yeq: "f -` y ∩ space M = (⋃ i. ((countable_preimages ?imY f) i) ∩ space M)" by auto
have "∀i. countable_preimages ?imY f i ∩ space M ∈ sets M"
by (metis ‹countable (range f ∩ y)› ‹y ∈ sets N› assms(2) inf_le2 le_inf_iff count_pre_meas sets.Int_space_eq1)
hence "(⋃ i. ((countable_preimages ?imY f) i) ∩ space M) ∈ sets M" by blast
thus "f -` y ∩ space M ∈ sets M" using yeq by simp
qed
qed
qed
lemma set_point_measurable:
assumes "point_measurable M (space N) Y"
and "B ⊆ space N"
and "countable B"
shows "(Y -`B) ∩ space M ∈ sets M"
proof -
have "Y -`B = (⋃ i. (countable_preimages B Y) i)" using assms
by (simp add: count_pre_union_img)
hence "Y -`B ∩ space M = (⋃ i. ((countable_preimages B Y) i ∩ space M))"
by auto
have "∀i. (countable_preimages B Y) i ∩ space M ∈ sets M" using assms by (simp add: count_pre_meas)
hence "(⋃ i. ((countable_preimages B Y) i ∩ space M)) ∈ sets M" by blast
show ?thesis
using ‹(⋃i. countable_preimages B Y i ∩ space M) ∈ sets M› ‹Y -` B ∩ space M = (⋃i. countable_preimages B Y i ∩ space M)› by auto
qed
subsection ‹Definition of explicit conditional expectation›
text ‹This section is devoted to an explicit computation of a conditional expectation for random variables
that have a countable codomain. More precisely, the computed random variable is almost everywhere equal to a conditional
expectation of the random variable under consideration.›
definition img_dce where
"img_dce M Y X = (λ y. if measure M ((Y -` {y}) ∩ space M) = 0 then 0 else
((integral⇧L M (λw. ((X w) * (indicator ((Y -`{y})∩ space M) w))))/(measure M ((Y -` {y}) ∩ space M))))"
definition expl_cond_expect where
"expl_cond_expect M Y X = (img_dce M Y X) ∘ Y"
lemma nn_expl_cond_expect_pos:
assumes "∀w ∈ space M. 0 ≤ X w"
shows "∀ w∈ space M. 0 ≤ (expl_cond_expect M Y X) w"
proof
fix w
assume space: "w∈ space M"
show "0 ≤ (expl_cond_expect M Y X) w"
proof (cases "measure M ((Y -` {Y w})∩ space M) = 0")
case True
thus "0 ≤ (expl_cond_expect M Y X) w" unfolding expl_cond_expect_def img_dce_def by simp
next
case False
hence "Y -`{Y w} ∩ space M ∈ sets M" using measure_notin_sets by blast
let ?indA = "((λ x. indicator ((Y -`{Y w})∩ space M) x))"
have "∀w ∈ space M. 0 ≤ (X w) * (?indA w)" by (simp add: assms)
hence "0 ≤ (integral⇧L M (λw. ((X w) * (?indA w))))" by simp
moreover have "(expl_cond_expect M Y X) w = (integral⇧L M (λw. ((X w) * (?indA w)))) / (measure M ((Y -` {Y w})∩ space M))"
unfolding expl_cond_expect_def img_dce_def using False by simp
moreover have "0 < measure M ((Y -` {Y w}) ∩ space M)" using False by (simp add: zero_less_measure_iff)
ultimately show "0 ≤ (expl_cond_expect M Y X) w" by simp
qed
qed
lemma expl_cond_expect_const:
assumes "Y w = Y y"
shows "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
unfolding expl_cond_expect_def img_dce_def
by (simp add: assms)
lemma expl_cond_exp_cong:
assumes "∀w∈space M. X w = Z w"
shows "∀w∈ space M. expl_cond_expect M Y X w = expl_cond_expect M Y Z w" unfolding expl_cond_expect_def img_dce_def
by (metis (no_types, lifting) Bochner_Integration.integral_cong assms(1) o_apply)
lemma expl_cond_exp_add:
assumes "integrable M X"
and "integrable M Z"
shows "∀w∈ space M. expl_cond_expect M Y (λx. X x + Z x) w = expl_cond_expect M Y X w + expl_cond_expect M Y Z w"
proof
fix w
assume "w∈ space M"
define prY where "prY = measure M ((Y -` {Y w}) ∩ space M)"
show "expl_cond_expect M Y (λx. X x + Z x) w = expl_cond_expect M Y X w + expl_cond_expect M Y Z w"
proof (cases "prY = 0")
case True
thus ?thesis unfolding expl_cond_expect_def img_dce_def prY_def by simp
next
case False
hence "(Y -` {Y w}) ∩ space M ∈ sets M" unfolding prY_def using measure_notin_sets by blast
let ?indA = "indicator ((Y -` {Y w}) ∩ space M)::('a⇒real)"
have "integrable M (λx. X x * ?indA x)"
using ‹Y -` {Y w} ∩ space M ∈ sets M› assms(1) integrable_real_mult_indicator by blast
moreover have "integrable M (λx. Z x * ?indA x)"
using ‹Y -` {Y w} ∩ space M ∈ sets M› assms(2) integrable_real_mult_indicator by blast
ultimately have "integral⇧L M (λx. X x * ?indA x + Z x * ?indA x) = integral⇧L M (λx. X x * ?indA x) + integral⇧L M (λx. Z x * ?indA x)"
using Bochner_Integration.integral_add by blast
moreover have "∀x∈ space M. X x * ?indA x + Z x * ?indA x = (X x + Z x) * ?indA x"
by (simp add: indicator_def)
ultimately have fsteq: "integral⇧L M (λx. (X x + Z x) * ?indA x) = integral⇧L M (λx. X x * ?indA x) + integral⇧L M (λx. Z x * ?indA x)"
by (metis (no_types, lifting) Bochner_Integration.integral_cong)
have "integral⇧L M (λx. (X x + Z x) * ?indA x/prY) = integral⇧L M (λx. (X x + Z x) * ?indA x)/prY"
by simp
also have "... = integral⇧L M (λx. X x * ?indA x)/prY + integral⇧L M (λx. Z x * ?indA x)/prY" using fsteq
by (simp add: add_divide_distrib)
also have "... = integral⇧L M (λx. X x * ?indA x/prY) + integral⇧L M (λx. Z x * ?indA x/prY)" by auto
finally have "integral⇧L M (λx. (X x + Z x) * ?indA x/prY) = integral⇧L M (λx. X x * ?indA x/prY) + integral⇧L M (λx. Z x * ?indA x/prY)" .
thus ?thesis using False unfolding expl_cond_expect_def img_dce_def
by (simp add: add_divide_distrib fsteq)
qed
qed
lemma expl_cond_exp_diff:
assumes "integrable M X"
and "integrable M Z"
shows "∀w∈ space M. expl_cond_expect M Y (λx. X x - Z x) w = expl_cond_expect M Y X w - expl_cond_expect M Y Z w"
proof
fix w
assume "w∈ space M"
define prY where "prY = measure M ((Y -` {Y w}) ∩ space M)"
show "expl_cond_expect M Y (λx. X x - Z x) w = expl_cond_expect M Y X w - expl_cond_expect M Y Z w"
proof (cases "prY = 0")
case True
thus ?thesis unfolding expl_cond_expect_def img_dce_def prY_def by simp
next
case False
hence "(Y -` {Y w}) ∩ space M ∈ sets M" unfolding prY_def using measure_notin_sets by blast
let ?indA = "indicator ((Y -` {Y w}) ∩ space M)::('a⇒real)"
have "integrable M (λx. X x * ?indA x)"
using ‹Y -` {Y w} ∩ space M ∈ sets M› assms(1) integrable_real_mult_indicator by blast
moreover have "integrable M (λx. Z x * ?indA x)"
using ‹Y -` {Y w} ∩ space M ∈ sets M› assms(2) integrable_real_mult_indicator by blast
ultimately have "integral⇧L M (λx. X x * ?indA x - Z x * ?indA x) = integral⇧L M (λx. X x * ?indA x) - integral⇧L M (λx. Z x * ?indA x)"
using Bochner_Integration.integral_diff by blast
moreover have "∀x∈ space M. X x * ?indA x - Z x * ?indA x = (X x - Z x) * ?indA x"
by (simp add: indicator_def)
ultimately have fsteq: "integral⇧L M (λx. (X x - Z x) * ?indA x) = integral⇧L M (λx. X x * ?indA x) - integral⇧L M (λx. Z x * ?indA x)"
by (metis (no_types, lifting) Bochner_Integration.integral_cong)
have "integral⇧L M (λx. (X x - Z x) * ?indA x/prY) = integral⇧L M (λx. (X x - Z x) * ?indA x)/prY"
by simp
also have "... = integral⇧L M (λx. X x * ?indA x)/prY - integral⇧L M (λx. Z x * ?indA x)/prY" using fsteq
by (simp add: diff_divide_distrib)
also have "... = integral⇧L M (λx. X x * ?indA x/prY) - integral⇧L M (λx. Z x * ?indA x/prY)" by auto
finally have "integral⇧L M (λx. (X x - Z x) * ?indA x/prY) = integral⇧L M (λx. X x * ?indA x/prY) - integral⇧L M (λx. Z x * ?indA x/prY)" .
thus ?thesis using False unfolding expl_cond_expect_def img_dce_def
by (simp add: diff_divide_distrib fsteq)
qed
qed
lemma expl_cond_expect_prop_sets:
assumes "disc_fct Y"
and "point_measurable M (space N) Y"
and "D = {w∈ space M. Y w ∈ space N ∧ (P (expl_cond_expect M Y X w))}"
shows "D∈ sets M"
proof -
let ?C = "{y ∈ (Y`(space M)) ∩ (space N). P (img_dce M Y X y)}"
have "space M ⊆ UNIV" by simp
hence "Y`(space M) ⊆ range Y" by auto
hence "countable (Y`(space M))" using assms countable_subset unfolding disc_fct_def by auto
hence "countable ?C" using assms unfolding disc_fct_def by auto
have eqset: "D = (⋃ b∈ ?C. Y-`{b})∩ space M"
proof
show "D⊆ (⋃ b∈ ?C. Y-`{b})∩ space M"
proof
fix w
assume "w∈ D"
hence "w∈ space M ∧ Y w ∈ (space N) ∧ (P (expl_cond_expect M Y X w))"
by (simp add: assms)
hence "P (img_dce M Y X (Y w))" by (simp add: expl_cond_expect_def)
hence "Y w ∈ ?C" using ‹w ∈ space M ∧ Y w ∈ space N ∧ P (expl_cond_expect M Y X w)› by blast
thus "w∈ (⋃ b∈ ?C. Y-`{b})∩ space M"
using ‹w ∈ space M ∧ Y w ∈ space N ∧ P (expl_cond_expect M Y X w)› by blast
qed
show "(⋃ b∈ ?C. Y-`{b})∩ space M ⊆ D"
proof
fix w
assume "w∈ (⋃ b∈ ?C. Y-`{b})∩ space M"
from this obtain b where "b∈ ?C ∧ w∈ Y-`{b}" by auto note bprops = this
hence "Y w = b" by auto
hence "Y w∈ space N" using bprops by simp
show "w ∈ D"
by (metis (mono_tags, lifting) IntE ‹Y w = b› ‹w ∈ (⋃b∈?C. Y -` {b}) ∩ space M› assms(3)
bprops mem_Collect_eq o_apply expl_cond_expect_def)
qed
qed
also have "... = (⋃ b∈ ?C. Y-`{b}∩ space M)" by blast
finally have "D = (⋃ b∈ ?C. Y-`{b}∩ space M)".
have "∀b∈ ?C. Y-`{b} ∩ space M ∈ sets M" using assms unfolding point_measurable_def by auto
hence "(⋃ b∈ ?C. Y-`{b}∩ space M) ∈ sets M" using ‹countable ?C› by blast
thus ?thesis
using ‹D = (⋃b∈?C. Y -` {b} ∩ space M)› by blast
qed
lemma expl_cond_expect_prop_sets2:
assumes "disc_fct Y"
and "point_measurable (fct_gen_subalgebra M N Y) (space N) Y"
and "D = {w∈ space M. Y w ∈ space N ∧ (P (expl_cond_expect M Y X w))}"
shows "D∈ sets (fct_gen_subalgebra M N Y)"
proof -
let ?C = "{y ∈ (Y`(space M)) ∩ (space N). P (img_dce M Y X y)}"
have "space M ⊆ UNIV" by simp
hence "Y`(space M) ⊆ range Y" by auto
hence "countable (Y`(space M))" using assms countable_subset unfolding disc_fct_def by auto
hence "countable ?C" using assms unfolding disc_fct_def by auto
have eqset: "D = (⋃ b∈ ?C. Y-`{b})∩ space M"
proof
show "D⊆ (⋃ b∈ ?C. Y-`{b})∩ space M"
proof
fix w
assume "w∈ D"
hence "w∈ space M ∧ Y w ∈ (space N) ∧ (P (expl_cond_expect M Y X w))"
by (simp add: assms)
hence "P (img_dce M Y X (Y w))" by (simp add: expl_cond_expect_def)
hence "Y w ∈ ?C" using ‹w ∈ space M ∧ Y w ∈ space N ∧ P (expl_cond_expect M Y X w)› by blast
thus "w∈ (⋃ b∈ ?C. Y-`{b})∩ space M"
using ‹w ∈ space M ∧ Y w ∈ space N ∧ P (expl_cond_expect M Y X w)› by blast
qed
show "(⋃ b∈ ?C. Y-`{b})∩ space M ⊆ D"
proof
fix w
assume "w∈ (⋃ b∈ ?C. Y-`{b})∩ space M"
from this obtain b where "b∈ ?C ∧ w∈ Y-`{b}" by auto note bprops = this
hence "Y w = b" by auto
hence "Y w∈ space N" using bprops by simp
show "w ∈ D"
by (metis (mono_tags, lifting) IntE ‹Y w = b› ‹w ∈ (⋃b∈?C. Y -` {b}) ∩ space M› assms(3)
bprops mem_Collect_eq o_apply expl_cond_expect_def)
qed
qed
also have "... = (⋃ b∈ ?C. Y-`{b}∩ space M)" by blast
finally have "D = (⋃ b∈ ?C. Y-`{b}∩ space M)".
have "space M = space (fct_gen_subalgebra M N Y)"
by (simp add: fct_gen_subalgebra_space)
hence "∀b∈ ?C. Y-`{b} ∩ space M ∈ sets (fct_gen_subalgebra M N Y)" using assms unfolding point_measurable_def by auto
hence "(⋃ b∈ ?C. Y-`{b}∩ space M) ∈ sets (fct_gen_subalgebra M N Y)" using ‹countable ?C› by blast
thus ?thesis
using ‹D = (⋃b∈?C. Y -` {b} ∩ space M)› by blast
qed
lemma expl_cond_expect_disc_fct:
assumes "disc_fct Y"
shows "disc_fct (expl_cond_expect M Y X)"
using assms unfolding disc_fct_def expl_cond_expect_def
by (metis countable_image image_comp)
lemma expl_cond_expect_point_meas:
assumes "disc_fct Y"
and "point_measurable M (space N) Y"
shows "point_measurable M UNIV (expl_cond_expect M Y X)"
proof -
have "disc_fct (expl_cond_expect M Y X)" using assms by (simp add: expl_cond_expect_disc_fct)
show ?thesis unfolding point_measurable_def
proof
show "(expl_cond_expect M Y X)`space M ⊆ UNIV" by simp
show "∀r∈range (expl_cond_expect M Y X) ∩ UNIV. expl_cond_expect M Y X -` {r} ∩ space M ∈ sets M"
proof
fix r
assume "r∈ range (expl_cond_expect M Y X) ∩ UNIV"
let ?D = "{w ∈ space M. Y w ∈ space N ∧ (expl_cond_expect M Y X w) = r}"
have "?D ∈ sets M" using expl_cond_expect_prop_sets[of Y M N ?D "λx. x = r" X] using assms by simp
moreover have "expl_cond_expect M Y X -`{r}∩ space M = ?D"
proof
show "expl_cond_expect M Y X -`{r}∩ space M ⊆ ?D"
proof
fix w
assume "w∈ expl_cond_expect M Y X -`{r}∩ space M"
hence "Y w ∈ space N"
by (meson IntD2 assms(1) assms(2) disct_fct_point_measurable measurable_space)
thus "w ∈ ?D"
using ‹w ∈ expl_cond_expect M Y X -` {r} ∩ space M› by blast
qed
show "?D ⊆ expl_cond_expect M Y X -`{r}∩ space M"
proof
fix w
assume "w∈ ?D"
thus "w∈ expl_cond_expect M Y X -`{r}∩ space M" by blast
qed
qed
ultimately show "expl_cond_expect M Y X -` {r} ∩ space M ∈ sets M" by simp
qed
qed
qed
lemma expl_cond_expect_borel_measurable:
assumes "disc_fct Y"
and "point_measurable M (space N) Y"
shows "(expl_cond_expect M Y X) ∈ borel_measurable M" using expl_cond_expect_point_meas[of Y M] assms
disct_fct_point_measurable[of "expl_cond_expect M Y X"]
by (simp add: expl_cond_expect_disc_fct)
lemma expl_cond_exp_borel:
assumes "Y ∈ space M → space N"
and "disc_fct Y"
and "∀r∈ range Y∩ space N. ∃A∈ sets N. range Y∩ A = {r}"
shows "(expl_cond_expect M Y X) ∈ borel_measurable (fct_gen_subalgebra M N Y)"
proof (intro borel_measurableI)
fix S::"real set"
assume "open S"
show "expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y) ∈ sets (fct_gen_subalgebra M N Y)"
proof (rule expl_cond_expect_prop_sets2)
show "disc_fct Y" using assms by simp
show "point_measurable (fct_gen_subalgebra M N Y) (space N) Y" using assms
by (simp add: singl_meas_if)
show "expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y) = {w ∈ space M. Y w ∈ space N ∧ (expl_cond_expect M Y X w) ∈ S}"
proof
show " expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y) ⊆ {w ∈ space M. Y w ∈ space N ∧ expl_cond_expect M Y X w ∈ S}"
proof
fix x
assume asm: "x ∈ expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y)"
hence "expl_cond_expect M Y X x ∈ S" by auto
moreover have "x∈ space M" using asm by (simp add:fct_gen_subalgebra_space)
ultimately show "x ∈{w ∈ space M. Y w ∈ space N ∧ expl_cond_expect M Y X w ∈ S}" using assms by auto
qed
show "{w ∈ space M. Y w ∈ space N ∧ expl_cond_expect M Y X w ∈ S} ⊆ expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y)"
proof
fix x
assume asm2: "x ∈ {w ∈ space M. Y w ∈ space N ∧ expl_cond_expect M Y X w ∈ S}"
hence "x∈ space (fct_gen_subalgebra M N Y)" by (simp add:fct_gen_subalgebra_space)
moreover have "x ∈ expl_cond_expect M Y X -`S" using asm2 by simp
ultimately show "x ∈ expl_cond_expect M Y X -` S ∩ space (fct_gen_subalgebra M N Y)" by simp
qed
qed
qed
qed
lemma expl_cond_expect_indic_borel_measurable:
assumes "disc_fct Y"
and "point_measurable M (space N) Y"
and "B⊆ space N"
and "countable B"
shows "(λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n ∩ space M) w)∈ borel_measurable M"
proof -
have "countable_preimages B Y n ∩ space M ∈ sets M" using assms by (auto simp add: count_pre_meas)
have "(expl_cond_expect M Y X)∈ borel_measurable M" using expl_cond_expect_point_meas[of Y M N X] assms
disct_fct_point_measurable[of "expl_cond_expect M Y X"]
by (simp add: expl_cond_expect_disc_fct)
moreover have "(indicator (countable_preimages B Y n ∩ space M))∈ borel_measurable M"
using ‹countable_preimages B Y n ∩ space M ∈ sets M› borel_measurable_indicator by blast
ultimately show ?thesis
using borel_measurable_times by blast
qed
lemma (in finite_measure) dce_prod:
assumes "point_measurable M (space N) Y"
and "integrable M X"
and "∀ w∈ space M. 0 ≤ X w"
shows "∀ w. (Y w) ∈ space N ⟶ (expl_cond_expect M Y X) w * measure M ((Y -` {Y w})∩ space M) = integral⇧L M (λy. (X y) * (indicator ((Y -`{Y w})∩ space M) y))"
proof (intro allI impI)
fix w
assume "Y w∈ space N"
let ?indY = "(λy. indicator ((Y -`{Y w})∩ space M) y)::'a ⇒ real"
show "expl_cond_expect M Y X w * measure M ((Y -` {Y w})∩ space M) = integral⇧L M (λy. (X y) * ?indY y) "
proof (cases "AE y in M. ?indY y = 0")
case True
hence "emeasure M ((Y -` {Y w})∩ space M) = 0"
proof -
have "AE y in M. y ∉ Y -` {Y w} ∩ space M"
using True eventually_elim2 by auto
hence "∃N∈ null_sets M.{x∈ space M. ¬(x∉ Y -` {Y w} ∩ space M)} ⊆ N"
using eventually_ae_filter[of "λx. x ∉ Y -` {Y w} ∩ space M" M] by simp
hence "∃N∈ null_sets M. {x∈ space M. x∈ Y -` {Y w} ∩ space M} ⊆ N" by simp
from this obtain N where "N∈ null_sets M" and "{x∈ space M. x∈ Y -` {Y w} ∩ space M} ⊆ N" by auto
note Nprops = this
have "{x∈ space M. x∈ Y -` {Y w}} ⊆ N" using Nprops by auto
hence "emeasure M {x∈ space M. x∈ Y -` {Y w}} ≤ emeasure M N"
by (simp add: emeasure_mono Nprops(1) null_setsD2)
thus ?thesis
by (metis (no_types, lifting) Collect_cong Int_def Nprops(1) le_zero_eq null_setsD1)
qed
hence "enn2real (emeasure M ((Y -` {Y w})∩ space M)) = 0" by simp
hence "measure M ((Y -` {Y w})∩ space M) = 0" unfolding measure_def by simp
hence lhs: "expl_cond_expect M Y X w = 0" unfolding expl_cond_expect_def img_dce_def by simp
have zer: "AE y in M. (X y) * ?indY y = (λy. 0) y" using True by auto
hence rhs: "integral⇧L M (λy. (X y) * ?indY y) = 0"
proof -
have "∀ w∈ space M. 0 ≤ X w * ?indY w" using assms by simp
have "integrable M (λy. (X y) * ?indY y)" using assms
by (metis (mono_tags, lifting) IntI UNIV_I ‹Y w ∈ space N› image_eqI integrable_cong integrable_real_mult_indicator point_measurable_def)
hence "(λy. (X y) * ?indY y) ∈ borel_measurable M" by blast
thus ?thesis using zer integral_cong_AE[of "(λy. (X y) * ?indY y)" M "λy. 0"] by simp
qed
thus "expl_cond_expect M Y X w*measure M ((Y -` {Y w})∩ space M) = integral⇧L M (λy. (X y) * ?indY y)" using lhs rhs by simp
next
case False
hence "¬(AE y in M. y ∉ (Y -`{Y w})∩ space M)"
by (simp add: indicator_eq_0_iff)
hence "emeasure M ((Y -` {Y w})∩ space M) ≠ 0"
proof -
have "(Y -` {Y w})∩ space M∈ sets M"
by (meson IntI UNIV_I ‹Y w ∈ space N› assms(1) image_eqI point_measurable_def)
have "(Y -` {Y w})∩ space M ∉ null_sets M"
using ‹¬ (AE y in M. y ∉ Y -` {Y w} ∩ space M)› eventually_ae_filter by blast
thus ?thesis
using ‹Y -` {Y w} ∩ space M ∈ sets M› by blast
qed
hence "measure M ((Y -` {Y w})∩ space M) ≠ 0"
by (simp add: emeasure_eq_measure)
thus "expl_cond_expect M Y X w* measure M ((Y -` {Y w})∩ space M) = integral⇧L M (λy. (X y) * ?indY y)" unfolding expl_cond_expect_def img_dce_def
using o_apply by auto
qed
qed
lemma expl_cond_expect_const_exp:
shows "integral⇧L M (λy. expl_cond_expect M Y X w * (indicator (Y -` {Y w} ∩ space M)) y) =
integral⇧L M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w} ∩ space M)) y)"
proof -
let ?ind = "(indicator (Y -` {Y w} ∩ space M))"
have "∀ y∈ space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof
fix y
assume "y∈ space M"
show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof (cases "y∈ Y -` {Y w} ∩ space M")
case False
thus ?thesis by simp
next
case True
hence "Y w = Y y" by auto
hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
using expl_cond_expect_const[of Y w y M X] by simp
thus ?thesis by simp
qed
qed
thus ?thesis
by (meson Bochner_Integration.integral_cong)
qed
lemma nn_expl_cond_expect_const_exp:
assumes "∀w∈ space M. 0 ≤ X w"
shows "integral⇧N M (λy. expl_cond_expect M Y X w * (indicator (Y -` {Y w} ∩ space M)) y) =
integral⇧N M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w} ∩ space M)) y)"
proof -
let ?ind = "(indicator (Y -` {Y w} ∩ space M))"
have forall: "∀ y∈ space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof
fix y
assume "y∈ space M"
show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof (cases "y∈ Y -` {Y w} ∩ space M")
case False
thus ?thesis by simp
next
case True
hence "Y w = Y y" by auto
hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
using expl_cond_expect_const[of Y] by blast
thus ?thesis by simp
qed
qed
show ?thesis
by (metis (no_types, lifting) forall nn_integral_cong)
qed
lemma (in finite_measure) nn_expl_cond_bounded:
assumes "∀w∈ space M. 0 ≤ X w"
and "integrable M X"
and "point_measurable M (space N) Y"
and "w∈ space M"
and "Y w∈ space N"
shows "integral⇧N M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w} ∩ space M)) y) < ∞"
proof -
let ?ind = "(indicator (Y -` {Y w} ∩ space M))::'a⇒real"
have "0 ≤ expl_cond_expect M Y X w" using assms nn_expl_cond_expect_pos[of M X Y] by simp
have "integrable M (λy. expl_cond_expect M Y X w * ?ind y)"
proof -
have eq: "(Y -`{Y w} ∩ space M) ∩ space M = (Y -`{Y w} ∩ space M)" by auto
have "(Y -` {Y w} ∩ space M) ∈ sets M" using assms
by (simp add: point_measurable_def)
moreover have "emeasure M (Y -`{Y w} ∩ space M) < ∞" by (simp add: inf.strict_order_iff)
ultimately have "integrable M (λy. ?ind y)"
using integrable_indicator_iff[of M "(Y -`{Y w} ∩ space M)"] by simp
thus ?thesis using integrable_mult_left_iff[of M "expl_cond_expect M Y X w" "?ind"] by blast
qed
have "∀y∈ space M. 0 ≤ expl_cond_expect M Y X w * ?ind y"
using ‹0 ≤ expl_cond_expect M Y X w› mult_nonneg_nonneg by blast
hence "∀y∈ space M. expl_cond_expect M Y X w * ?ind y = norm (expl_cond_expect M Y X w * ?ind y)" by auto
hence inf: "integral⇧N M (λy. expl_cond_expect M Y X w * ?ind y) < ∞"
using integrable_iff_bounded[of M "(λy. expl_cond_expect M Y X w * ?ind y)"]
‹0 ≤ expl_cond_expect M Y X w› real_norm_def nn_integral_cong
by (metis (no_types, lifting) ‹integrable M (λy. expl_cond_expect M Y X w * indicator (Y -` {Y w} ∩ space M) y)›)
have "integral⇧N M (λy. expl_cond_expect M Y X y * ?ind y) =
integral⇧N M (λy. expl_cond_expect M Y X w * ?ind y)" using assms
by (simp add: nn_expl_cond_expect_const_exp)
also have "... < ∞" using inf by simp
finally show ?thesis .
qed
lemma (in finite_measure) count_prod:
fixes Y::"'a⇒'b"
assumes "B⊆ space N"
and "point_measurable M (space N) Y"
and "integrable M X"
and "∀ w ∈ space M. 0 ≤ X w"
shows "∀i. integral⇧L M (λy. (X y) * (indicator (countable_preimages B Y i ∩ space M)) y) =
integral⇧L M (λy. (expl_cond_expect M Y X y) * (indicator (countable_preimages B Y i ∩ space M)) y)"
proof
fix i
show "integral⇧L M (λy. X y * indicator (countable_preimages B Y i ∩ space M) y) =
integral⇧L M (λy. expl_cond_expect M Y X y * indicator (countable_preimages B Y i ∩ space M) y)"
proof (cases "countable_preimages B Y i ∩ space M = {}")
case True
thus ?thesis by simp
next
case False
from this obtain w where "w∈ countable_preimages B Y i" by auto
hence "Y w = (from_nat_into B) i" by (meson count_pre_img)
hence "Y w ∈ B"
proof (cases "infinite B")
case True
thus ?thesis
by (simp add: ‹Y w = from_nat_into B i› from_nat_into infinite_imp_nonempty)
next
case False
thus ?thesis
by (metis Finite_Set.card_0_eq ‹Y w = from_nat_into B i› ‹w ∈ countable_preimages B Y i› countable_preimages_def equals0D from_nat_into gr_implies_not0)
qed
let ?ind = "(indicator (Y -` {Y w} ∩ space M))::'a⇒real"
have "integral⇧L M (λy. (X y) * (indicator (countable_preimages B Y i ∩ space M)) y) = integral⇧L M (λy. X y * ?ind y)"
by (metis (no_types, hide_lams) ‹Y w = from_nat_into B i› ‹⋀thesis. (⋀w. w ∈ countable_preimages B Y i ⟹ thesis) ⟹ thesis› countable_preimages_def empty_iff)
also have "... =
expl_cond_expect M Y X w * measure M (Y -` {Y w} ∩ space M)" using dce_prod[of N Y X]
by (metis (no_types, lifting) ‹Y w ∈ B› assms subsetCE)
also have "... = expl_cond_expect M Y X w * (integral⇧L M ?ind)"
by auto
also have "... = integral⇧L M (λy. expl_cond_expect M Y X w * ?ind y)"
by auto
also have "... = integral⇧L M (λy. expl_cond_expect M Y X y * ?ind y)"
proof -
have "∀ y∈ space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof
fix y
assume "y∈ space M"
show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
proof (cases "y∈ Y -` {Y w} ∩ space M")
case False
thus ?thesis by simp
next
case True
hence "Y w = Y y" by auto
hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
using expl_cond_expect_const[of Y] by blast
thus ?thesis by simp
qed
qed
thus ?thesis
by (meson Bochner_Integration.integral_cong)
qed
also have "... = integral⇧L M (λy. expl_cond_expect M Y X y * indicator (countable_preimages B Y i ∩ space M) y)"
by (metis (no_types, hide_lams) ‹Y w = from_nat_into B i› ‹⋀thesis. (⋀w. w ∈ countable_preimages B Y i ⟹ thesis) ⟹ thesis› countable_preimages_def empty_iff)
finally show ?thesis .
qed
qed
lemma (in finite_measure) count_pre_integrable:
assumes "point_measurable M (space N) Y"
and "disc_fct Y"
and "B⊆ space N"
and "countable B"
and "integrable M X"
and "∀ w ∈ space M. 0 ≤ X w"
shows "integrable M (λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n ∩ space M) w)"
proof-
have "integral⇧L M (λy. (X y) * (indicator (countable_preimages B Y n ∩ space M)) y) =
integral⇧L M (λy. (expl_cond_expect M Y X y) * (indicator (countable_preimages B Y n ∩ space M)) y)" using assms count_prod
by blast
have "∀w ∈ space M. 0 ≤ (expl_cond_expect M Y X w) * (indicator (countable_preimages B Y n ∩ space M)) w"
by (simp add: assms nn_expl_cond_expect_pos)
have "countable_preimages B Y n ∩ space M ∈ sets M" using count_pre_meas[of M] assms by auto
hence "integrable M (λw. X w * indicator (countable_preimages B Y n ∩ space M) w)"
using assms integrable_real_mult_indicator by blast
show ?thesis
proof (rule integrableI_nonneg)
show "(λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n ∩ space M) w)∈ borel_measurable M"
proof -
have "(expl_cond_expect M Y X)∈ borel_measurable M" using expl_cond_expect_point_meas[of Y M N X] assms
disct_fct_point_measurable[of "expl_cond_expect M Y X"]
by (simp add: expl_cond_expect_disc_fct)
moreover have "(indicator (countable_preimages B Y n ∩ space M))∈ borel_measurable M"
using ‹countable_preimages B Y n ∩ space M ∈ sets M› borel_measurable_indicator by blast
ultimately show ?thesis
using borel_measurable_times by blast
qed
show "AE x in M. 0 ≤ expl_cond_expect M Y X x * indicator (countable_preimages B Y n ∩ space M) x"
by (simp add: ‹∀w∈space M. 0 ≤ expl_cond_expect M Y X w * indicator (countable_preimages B Y n ∩ space M) w›)
show "(∫⇧+ x. ennreal (expl_cond_expect M Y X x * indicator (countable_preimages B Y n ∩ space M) x) ∂M) < ∞"
proof (cases "countable_preimages B Y n ∩ space M = {}")
case True
thus ?thesis by simp
next
case False
from this obtain w where "w∈ countable_preimages B Y n∩ space M" by auto
hence "countable_preimages B Y n = Y -`{Y w}"
by (metis IntD1 count_pre_img countable_preimages_def equals0D)
have "w∈ space M" using False
using ‹w ∈ countable_preimages B Y n ∩ space M› by blast
moreover have "Y w ∈ space N"
by (meson ‹w ∈ space M› assms(1) assms(2) disct_fct_point_measurable measurable_space)
ultimately show ?thesis using assms nn_expl_cond_bounded[of X N Y]
using ‹countable_preimages B Y n = Y -` {Y w}› by presburger
qed
qed
qed
lemma (in finite_measure) nn_cond_expl_is_cond_exp_tmp:
assumes "∀ w∈ space M. 0 ≤ X w"
and "integrable M X"
and "disc_fct Y"
and "point_measurable M (space M') Y"
shows "∀ A ∈ sets M'. integrable M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A)∩ (space M)) w)) ∧
integral⇧L M (λw. (X w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A) ∩ (space M))) w)"
proof
fix A
assume "A ∈ sets M'"
let ?imA = "A ∩ (range Y)"
have "countable ?imA" using assms disc_fct_def by blast
have "Y -`A = Y -`?imA" by auto
define prY where "prY = countable_preimages ?imA Y"
have un: "Y -`?imA = (⋃ i. prY i)" using ‹countable ?imA›
by (metis count_pre_union_img prY_def)
have "(Y -`?imA) ∩ (space M) = (⋃ i. prY i) ∩ (space M)" using ‹Y -`A = Y -`?imA› un by simp
also have "... = (⋃ i. (prY i) ∩ (space M))" by blast
finally have eq2: "(Y -`?imA) ∩ (space M) = (⋃ i. (prY i) ∩ (space M))".
define indpre::"nat ⇒ 'a ⇒ real" where "indpre = (λ i x. (indicator ((prY i) ∩ (space M))) x)"
have "∀ i. indpre i ∈ borel_measurable M"
proof
fix i
show "indpre i ∈ borel_measurable M" unfolding indpre_def prY_def
proof (rule borel_measurable_indicator, cases "countable_preimages (A ∩ range Y) Y i ∩ space M = {}")
case True
thus "countable_preimages (A ∩ range Y) Y i ∩ space M ∈ sets M" by simp
next
case False
from this obtain x where "x∈ countable_preimages (A ∩ range Y) Y i ∩ space M" by blast
hence "Y x ∈ space M'"
by (metis Int_iff UN_I ‹A ∈ sets M'› ‹prY ≡ countable_preimages (A ∩ range Y) Y› imageE
rangeI sets.sets_into_space subset_eq un vimage_eq)
thus "countable_preimages (A ∩ range Y) Y i ∩ space M ∈ sets M"
by (metis IntE IntI ‹x ∈ countable_preimages (A ∩ range Y) Y i ∩ space M› assms(4)
count_pre_img countable_preimages_def empty_iff point_measurable_def rangeI)
qed
qed
have "∀i. integrable M (λw. (X w) * indpre i w)"
proof
fix i
show "integrable M (λw. (X w) * indpre i w)" unfolding indpre_def prY_def
proof (rule integrable_real_mult_indicator)
show "countable_preimages (A ∩ range Y) Y i ∩ space M ∈ sets M"
proof (cases "countable_preimages (A ∩ range Y) Y i = {}")
case True
thus "countable_preimages (A ∩ range Y) Y i ∩ space M ∈ sets M" by (simp add: True)
next
case False
hence "Y -` {(from_nat_into (A ∩ range Y)) i} ≠ {}" unfolding countable_preimages_def by meson
have "(infinite (A ∩ range Y)) ∨ (finite (A ∩ range Y) ∧ i < card (A ∩ range Y))" using False unfolding countable_preimages_def
by meson
show ?thesis
by (metis ‹A ∈ sets M'› ‹countable (A ∩ range Y)› assms(4) count_pre_meas le_inf_iff
range_from_nat_into sets.Int_space_eq1 sets.empty_sets sets.sets_into_space subset_range_from_nat_into)
qed
show "integrable M X" using assms by simp
qed
qed
hence prod_bm: "∀ i. (λw. (X w) * indpre i w) ∈ borel_measurable M"
by (simp add: assms(2) borel_measurable_integrable borel_measurable_times)
have posprod: "∀ i w. 0 ≤ (X w) * indpre i w"
proof (intro allI)
fix i
fix w
show "0 ≤ (X w) * indpre i w"
by (metis IntE assms(1) indicator_pos_le indicator_simps(2) indpre_def mult_eq_0_iff mult_sign_intros(1))
qed
let ?indA = "indicator ((Y -`(A ∩ range Y))∩ (space M))::'a⇒real"
have "∀ i j. i ≠ j ⟶ ((prY i) ∩ (space M)) ∩ ((prY j) ∩ (space M)) = {}"
by (simp add: ‹countable (A ∩ range Y)› ‹prY ≡ countable_preimages (A ∩ range Y) Y› count_pre_disj inf_commute inf_sup_aci(3))
hence sumind: "∀x. (λi. indpre i x) sums ?indA x" using ‹countable ?imA› eq2 unfolding prY_def indpre_def
by (metis indicator_sums)
hence sumxlim: "∀x. (λi. (X x) * indpre i x::real) sums ((X x) * indicator ((Y -`?imA) ∩ (space M)) x)" using ‹countable ?imA› unfolding prY_def
using sums_mult by blast
hence sum: "∀x. (∑ i.((X x) * indpre i x)::real) = (X x) * indicator ((Y -`?imA) ∩ (space M)) x" by (metis sums_unique)
hence b: "∀ w. 0 ≤ (∑ i.((X w) * indpre i w))" using suminf_nonneg
by (metis ‹∀x. (λi. X x * indpre i x) sums (X x * indicator (Y -` (A ∩ range Y) ∩ space M) x)› posprod summable_def)
have sumcondlim: "∀x. (λi. (expl_cond_expect M Y X x) * indpre i x::real) sums ((expl_cond_expect M Y X x) * ?indA x)" using ‹countable ?imA› unfolding prY_def
using sums_mult sumind by blast
have "integrable M (λw. (X w) * ?indA w)"
proof (rule integrable_real_mult_indicator)
show "Y -` (A∩ range Y) ∩ space M ∈ sets M"
using ‹A ∈ sets M'› assms(3) assms(4) disct_fct_point_measurable measurable_sets
by (metis ‹Y -` A = Y -` (A ∩ range Y)›)
show "integrable M X" using assms by simp
qed
hence intsum: "integrable M (λw. (∑i. ((X w) * indpre i w)))" using sum
integrable_cong[of M M "λ w.(X w) * (indicator ((Y -`A)∩ (space M)) w)" "λw. (∑ i.((X w) * indpre i w))"]
using ‹Y -` A = Y -` (A ∩ range Y)› by presburger
have "integral⇧L M (λw. (X w) * ?indA w) = integral⇧L M (λw. (∑ i.((X w) * indpre i w)))"
using ‹Y -` A = Y -` (A ∩ range Y)› sum by auto
also have "... =
∫⇧+ w. ((∑ i. ((X w) * indpre i w))) ∂M" using nn_integral_eq_integral
by (metis (mono_tags, lifting) AE_I2 intsum b nn_integral_cong)
also have "(∫⇧+ w. ((∑ i. ((X w) * indpre i w))) ∂M) = ∫⇧+ w. ((∑ i. ennreal ((X w) * indpre i w))) ∂M" using suminf_ennreal2 summable_def posprod sum sumxlim
proof -
{ fix aa :: 'a
have "∀a. ennreal (∑n. X a * indpre n a) = (∑n. ennreal (X a * indpre n a))"
by (metis (full_types) posprod suminf_ennreal2 summable_def sumxlim)
then have "(∫⇧+ a. ennreal (∑n. X a * indpre n a) ∂M) = (∫⇧+ a. (∑n. ennreal (X a * indpre n a)) ∂M) ∨ ennreal (∑n. X aa * indpre n aa) = (∑n. ennreal (X aa * indpre n aa))"
by metis }
then show ?thesis
by presburger
qed
also have "... = (∑i. integral⇧N M ((λi w. (X w) * indpre i w) i))"
proof (intro nn_integral_suminf)
fix i
show "(λx. ennreal (X x * indpre i x))∈ borel_measurable M"
using measurable_compose_rev measurable_ennreal prod_bm by blast
qed
also have "... = (∑i. integral⇧N M ((λi w. (expl_cond_expect M Y X w) * indpre i w) i))"
proof (intro suminf_cong)
fix n
have "A ∩ range Y ⊆ space M'"
using ‹A ∈ sets M'› sets.Int_space_eq1 by auto
have "integral⇧N M (λw. (X w) * indpre n w) = integral⇧L M (λw. (X w) * indpre n w)"
using nn_integral_eq_integral[of M "λw. (X w) * indpre n w"]
by (simp add: ‹∀i. integrable M (λw. X w * indpre i w)› posprod)
also have "... = integral⇧L M (λw. (expl_cond_expect M Y X) w * indpre n w)"
proof -
have "integral⇧L M (λw. X w * indicator (countable_preimages (A ∩ range Y) Y n ∩ space M) w) =
integral⇧L M (λw. expl_cond_expect M Y X w * indicator (countable_preimages (A ∩ range Y) Y n ∩ space M) w)"
using count_prod[of "A∩ range Y" "M'" Y X ] assms ‹A ∩ range Y ⊆ space M'› by blast
thus ?thesis
using ‹indpre ≡ λi. indicator (prY i ∩ space M)› prY_def by presburger
qed
also have "... = integral⇧N M (λw. (expl_cond_expect M Y X) w * indpre n w)"
proof -
have "integrable M (λw. (expl_cond_expect M Y X) w * indpre n w)" unfolding indpre_def prY_def
using count_pre_integrable assms ‹A ∩ range Y ⊆ space M'› ‹countable (A ∩ range Y)› by blast
moreover have "AE w in M. 0 ≤ (expl_cond_expect M Y X) w * indpre n w"
by (simp add: ‹indpre ≡ λi. indicator (prY i ∩ space M)› assms(1) nn_expl_cond_expect_pos)
ultimately show ?thesis by (simp add:nn_integral_eq_integral)
qed
finally show "integral⇧N M (λw. (X w) * indpre n w) = integral⇧N M (λw. (expl_cond_expect M Y X) w * indpre n w)" .
qed
also have "... = integral⇧N M (λw. ∑i. ((expl_cond_expect M Y X w) * indpre i w))"
proof -
have "(λx. (∑i. ennreal (expl_cond_expect M Y X x * indpre i x))) =
(λx. ennreal (∑i. (expl_cond_expect M Y X x * indpre i x)))"
proof-
have posex: "∀ i x. 0 ≤ (expl_cond_expect M Y X x) * (indpre i x)"
by (metis IntE ‹indpre ≡ λi. indicator (prY i ∩ space M)› assms(1) indicator_pos_le indicator_simps(2) mult_eq_0_iff mult_sign_intros(1) nn_expl_cond_expect_pos)
have "∀x. (∑i. ennreal (expl_cond_expect M Y X x * indpre i x)) = (ennreal (∑i. (expl_cond_expect M Y X x * indpre i x)))"
proof
fix x
show "(∑i. ennreal (expl_cond_expect M Y X x * indpre i x)) = (ennreal (∑i. (expl_cond_expect M Y X x * indpre i x)))"
using suminf_ennreal2[of "λi. (expl_cond_expect M Y X x * indpre i x)"] sumcondlim summable_def posex
proof -
have f1: "summable (λn. expl_cond_expect M Y X x * indpre n x)"
using sumcondlim summable_def by blast
obtain nn :: nat where
"¬ 0 ≤ expl_cond_expect M Y X x * indpre nn x ∨ ¬ summable (λn. expl_cond_expect M Y X x * indpre n x) ∨ ennreal (∑n. expl_cond_expect M Y X x * indpre n x) = (∑n. ennreal (expl_cond_expect M Y X x * indpre n x))"
by (metis (full_types) ‹⟦⋀i. 0 ≤ expl_cond_expect M Y X x * indpre i x; summable (λi. expl_cond_expect M Y X x * indpre i x)⟧ ⟹ (∑i. ennreal (expl_cond_expect M Y X x * indpre i x)) = ennreal (∑i. expl_cond_expect M Y X x * indpre i x)›)
then show ?thesis
using f1 posex by presburger
qed
qed
thus ?thesis by simp
qed
have "∀i. (λw. (expl_cond_expect M Y X w) * indpre i w) ∈ borel_measurable M"
proof -
show ?thesis
using ‹∀i. (indpre i)∈ borel_measurable M› assms(3) assms(4) borel_measurable_times expl_cond_expect_borel_measurable by blast
qed
hence "⋀i. (λx. ennreal (expl_cond_expect M Y X x * indpre i x))∈ borel_measurable M"
using measurable_compose_rev measurable_ennreal by blast
thus ?thesis using nn_integral_suminf[of "(λi w. (expl_cond_expect M Y X w) * indpre i w)" M, symmetric]
using ‹(λx. ∑i. ennreal (expl_cond_expect M Y X x * indpre i x)) = (λx. ennreal (∑i. expl_cond_expect M Y X x * indpre i x))› by auto
qed
also have "... = integral⇧N M (λw. (expl_cond_expect M Y X w) * ?indA w)"
using sumcondlim
by (metis (no_types, lifting) sums_unique)
also have "... = integral⇧L M (λw. (expl_cond_expect M Y X w) * ?indA w)"
proof -
have scdint: "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
proof -
have rv: "(λw. (expl_cond_expect M Y X w) * indicator ((Y -`?imA) ∩ (space M)) w) ∈ borel_measurable M"
proof -
have "expl_cond_expect M Y X ∈ borel_measurable M" using expl_cond_expect_borel_measurable
using assms by blast
moreover have "(Y -`?imA) ∩ (space M) ∈ sets M"
by (metis ‹A ∈ sets M'› ‹Y -` A = Y -` (A ∩ range Y)› assms(3) assms(4) disct_fct_point_measurable measurable_sets)
ultimately show ?thesis
using borel_measurable_indicator_iff borel_measurable_times by blast
qed
moreover have born: "integral⇧N M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) < ∞"
proof -
have "integral⇧N M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) =
integral⇧N M (λw. ennreal (expl_cond_expect M Y X w * ?indA w))"
proof -
have "∀w∈ space M. norm (expl_cond_expect M Y X w * ?indA w) = expl_cond_expect M Y X w * ?indA w"
using nn_expl_cond_expect_pos by (simp add: nn_expl_cond_expect_pos assms(1))
thus ?thesis by (metis (no_types, lifting) nn_integral_cong)
qed
thus ?thesis
by (metis (no_types, lifting)
‹(∑i. ∫⇧+ x. ennreal (X x * indpre i x) ∂M) = (∑i. ∫⇧+ x. ennreal (expl_cond_expect M Y X x * indpre i x) ∂M)›
‹(∑i. ∫⇧+ x. ennreal (expl_cond_expect M Y X x * indpre i x) ∂M) = (∫⇧+ x. ennreal (∑i. expl_cond_expect M Y X x * indpre i x) ∂M)›
‹(∫⇧+ w. (∑i. ennreal (X w * indpre i w)) ∂M) = (∑i. ∫⇧+ x. ennreal (X x * indpre i x) ∂M)›
‹(∫⇧+ x. ennreal (∑i. X x * indpre i x) ∂M) = (∫⇧+ w. (∑i. ennreal (X w * indpre i w)) ∂M)›
‹(∫⇧+ x. ennreal (∑i. expl_cond_expect M Y X x * indpre i x) ∂M) = (∫⇧+ x. ennreal (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x) ∂M)›
‹ennreal (integral⇧L M (λw. ∑i. X w * indpre i w)) = (∫⇧+ x. ennreal (∑i. X x * indpre i x) ∂M)›
ennreal_less_top infinity_ennreal_def)
qed
show "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
proof (rule iffD2[OF integrable_iff_bounded])
show "((λw. expl_cond_expect M Y X w * indicator (Y -` (A ∩ range Y) ∩ space M) w) ∈ borel_measurable M) ∧
((∫⇧+ x. (ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x))) ∂M) < ∞)"
proof
show "(λw. expl_cond_expect M Y X w * indicator (Y -` (A ∩ range Y) ∩ space M) w)∈ borel_measurable M"
using rv by simp
show "(∫⇧+ x. ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x)) ∂M) < ∞"
using born by simp
qed
qed
qed
moreover have "∀w∈ space M. 0 ≤ (expl_cond_expect M Y X w) * indicator ((Y -`?imA) ∩ (space M)) w"
by (simp add: assms(1) nn_expl_cond_expect_pos)
ultimately show ?thesis using nn_integral_eq_integral
by (metis (mono_tags, lifting) AE_I2 nn_integral_cong)
qed
finally have myeq: "ennreal (integral⇧L M (λw. (X w) * ?indA w)) = integral⇧L M (λw. (expl_cond_expect M Y X w) * ?indA w)" .
thus "integrable M (λw. expl_cond_expect M Y X w * indicator (Y -` A ∩ space M) w) ∧ integral⇧L M (λw. X w * indicator (Y -` A ∩ space M) w) =
integral⇧L M (λw. expl_cond_expect M Y X w * indicator (Y -` A ∩ space M) w)"
proof -
have "0 ≤ integral⇧L M (λw. X w * indicator (Y -` A ∩ space M) w)"
using ‹Y -` A = Y -` (A ∩ range Y)› b sum by fastforce
moreover have "0 ≤ integral⇧L M (λw. expl_cond_expect M Y X w * indicator (Y -` A ∩ space M) w)"
by (simp add: assms(1) nn_expl_cond_expect_pos)
ultimately have expeq: "integral⇧L M (λw. X w * indicator (Y -` A ∩ space M) w) =
integral⇧L M (λw. expl_cond_expect M Y X w * indicator (Y -` A ∩ space M) w)"
by (metis (mono_tags, lifting) Bochner_Integration.integral_cong ‹Y -` A = Y -` (A ∩ range Y)› ennreal_inj myeq)
have "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
proof -
have rv: "(λw. (expl_cond_expect M Y X w) * indicator ((Y -`?imA) ∩ (space M)) w) ∈ borel_measurable M"
proof -
have "expl_cond_expect M Y X ∈ borel_measurable M" using expl_cond_expect_borel_measurable
using assms by blast
moreover have "(Y -`?imA) ∩ (space M) ∈ sets M"
by (metis ‹A ∈ sets M'› ‹Y -` A = Y -` (A ∩ range Y)› assms(3) assms(4) disct_fct_point_measurable measurable_sets)
ultimately show ?thesis
using borel_measurable_indicator_iff borel_measurable_times by blast
qed
moreover have born: "integral⇧N M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) < ∞"
proof -
have "integral⇧N M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) =
integral⇧N M (λw. ennreal (expl_cond_expect M Y X w * ?indA w))"
proof -
have "∀w∈ space M. norm (expl_cond_expect M Y X w * ?indA w) = expl_cond_expect M Y X w * ?indA w"
using nn_expl_cond_expect_pos by (simp add: nn_expl_cond_expect_pos assms(1))
thus ?thesis by (metis (no_types, lifting) nn_integral_cong)
qed
thus ?thesis
by (metis (no_types, lifting)
‹(∑i. ∫⇧+ x. ennreal (X x * indpre i x) ∂M) = (∑i. ∫⇧+ x. ennreal (expl_cond_expect M Y X x * indpre i x) ∂M)›
‹(∑i. ∫⇧+ x. ennreal (expl_cond_expect M Y X x * indpre i x) ∂M) = (∫⇧+ x. ennreal (∑i. expl_cond_expect M Y X x * indpre i x) ∂M)›
‹(∫⇧+ w. (∑i. ennreal (X w * indpre i w)) ∂M) = (∑i. ∫⇧+ x. ennreal (X x * indpre i x) ∂M)›
‹(∫⇧+ x. ennreal (∑i. X x * indpre i x) ∂M) = (∫⇧+ w. (∑i. ennreal (X w * indpre i w)) ∂M)›
‹(∫⇧+ x. ennreal (∑i. expl_cond_expect M Y X x * indpre i x) ∂M) = (∫⇧+ x. ennreal (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x) ∂M)›
‹ennreal (integral⇧L M (λw. ∑i. X w * indpre i w)) = (∫⇧+ x. ennreal (∑i. X x * indpre i x) ∂M)›
ennreal_less_top infinity_ennreal_def)
qed
show "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
proof (rule iffD2[OF integrable_iff_bounded])
show "((λw. expl_cond_expect M Y X w * indicator (Y -` (A ∩ range Y) ∩ space M) w) ∈ borel_measurable M) ∧
((∫⇧+ x. (ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x))) ∂M) < ∞)"
proof
show "(λw. expl_cond_expect M Y X w * indicator (Y -` (A ∩ range Y) ∩ space M) w)∈ borel_measurable M"
using rv by simp
show "(∫⇧+ x. ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A ∩ range Y) ∩ space M) x)) ∂M) < ∞"
using born by simp
qed
qed
qed
hence "integrable M (λw. expl_cond_expect M Y X w * indicator (Y -` A ∩ space M) w)"
using ‹Y -` A = Y -` (A ∩ range Y)› by presburger
thus ?thesis using expeq by simp
qed
qed
lemma (in finite_measure) nn_expl_cond_exp_integrable:
assumes "∀ w∈ space M. 0 ≤ X w"
and "integrable M X"
and "disc_fct Y"
and "point_measurable M (space N) Y"
shows "integrable M (expl_cond_expect M Y X)"
proof -
have "Y-`space N ∩ space M = space M"
by (meson assms(3) assms(4) disct_fct_point_measurable inf_absorb2 measurable_space subsetI vimageI)
let ?indA = "indicator ((Y -`space N)∩ (space M))::'a⇒real"
have "∀w∈ space M. (?indA w)= (1::real)" by (simp add: ‹Y -` space N ∩ space M = space M›)
hence "∀w∈ space M. ((expl_cond_expect M Y X) w) * (?indA w) = (expl_cond_expect M Y X) w" by simp
moreover have "integrable M (λw. ((expl_cond_expect M Y X) w) * (?indA w))" using assms
nn_cond_expl_is_cond_exp_tmp[of X Y N] by blast
ultimately show ?thesis by (metis (no_types, lifting) integrable_cong)
qed
lemma (in finite_measure) nn_cond_expl_is_cond_exp:
assumes "∀ w∈ space M. 0 ≤ X w"
and "integrable M X"
and "disc_fct Y"
and "point_measurable M (space N) Y"
shows "∀ A ∈ sets N. integral⇧L M (λw. (X w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A) ∩ (space M))) w)"
by (metis (mono_tags, lifting) assms nn_cond_expl_is_cond_exp_tmp)
lemma (in finite_measure) expl_cond_exp_integrable:
assumes "integrable M X"
and "disc_fct Y"
and "point_measurable M (space N) Y"
shows "integrable M (expl_cond_expect M Y X)"
proof -
let ?zer = "λw. 0"
let ?Xp = "λw. max (?zer w) (X w)"
let ?Xn = "λw. max (?zer 0) (-X w)"
have "∀w. X w = ?Xp w - ?Xn w" by auto
have ints: "integrable M ?Xp" "integrable M ?Xn" using integrable_max assms by auto
hence "integrable M (expl_cond_expect M Y ?Xp)" using assms nn_expl_cond_exp_integrable
by (metis max.cobounded1)
moreover have "integrable M (expl_cond_expect M Y ?Xn)" using ints assms nn_expl_cond_exp_integrable
by (metis max.cobounded1)
ultimately have integr: "integrable M (λw. (expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w)" by auto
have "∀w∈ space M. (expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = (expl_cond_expect M Y X) w"
proof
fix w
assume "w∈ space M"
hence "(expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = (expl_cond_expect M Y (λx. ?Xp x - ?Xn x)) w"
using ints by (simp add: expl_cond_exp_diff)
also have "... = expl_cond_expect M Y X w" using expl_cond_exp_cong ‹∀w. X w = ?Xp w - ?Xn w› by auto
finally show "(expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = expl_cond_expect M Y X w" .
qed
thus ?thesis using integr
by (metis (mono_tags, lifting) integrable_cong)
qed
lemma (in finite_measure) is_cond_exp:
assumes "integrable M X"
and "disc_fct Y"
and "point_measurable M (space N) Y"
shows "∀ A ∈ sets N. integral⇧L M (λw. (X w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A) ∩ (space M))) w)"
proof -
let ?zer = "λw. 0"
let ?Xp = "λw. max (?zer w) (X w)"
let ?Xn = "λw. max (?zer 0) (-X w)"
have "∀w. X w = ?Xp w - ?Xn w" by auto
have ints: "integrable M ?Xp" "integrable M ?Xn" using integrable_max assms by auto
hence posint: "integrable M (expl_cond_expect M Y ?Xp)" using assms nn_expl_cond_exp_integrable
by (metis max.cobounded1)
have negint: "integrable M (expl_cond_expect M Y ?Xn)" using ints assms nn_expl_cond_exp_integrable
by (metis max.cobounded1)
have eqp: "∀ A ∈ sets N. integral⇧L M (λw. (?Xp w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A) ∩ (space M))) w)"
using nn_cond_expl_is_cond_exp[of ?Xp Y N] assms by auto
have eqn: "∀ A ∈ sets N. integral⇧L M (λw. (?Xn w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A) ∩ (space M))) w)"
using nn_cond_expl_is_cond_exp[of ?Xn Y N] assms by auto
show "∀ A ∈ sets N. integral⇧L M (λw. (X w) * (indicator ((Y -`A)∩ (space M)) w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A) ∩ (space M))) w)"
proof
fix A
assume "A∈ sets N"
let ?imA = "A ∩ (range Y)"
have "countable ?imA" using assms disc_fct_def by blast
have "Y -`A = Y -`?imA" by auto
have yev: "Y -` (A∩ range Y) ∩ space M ∈ sets M"
using ‹A ∈ sets N› assms(3) assms(2) disct_fct_point_measurable measurable_sets
by (metis ‹Y -` A = Y -` (A ∩ range Y)›)
let ?indA = "indicator ((Y -`(A ∩ range Y))∩ (space M))::'a⇒real"
have intp: "integrable M (λw. (?Xp w) * ?indA w)"
proof (rule integrable_real_mult_indicator)
show "Y -` (A∩ range Y) ∩ space M ∈ sets M" using yev by simp
show "integrable M ?Xp" using assms by simp
qed
have intn: "integrable M (λw. (?Xn w) * ?indA w)"
proof (rule integrable_real_mult_indicator)
show "Y -` (A∩ range Y) ∩ space M ∈ sets M" using yev by simp
show "integrable M ?Xn" using assms by simp
qed
have exintp: "integrable M (λw. (expl_cond_expect M Y ?Xp w) * ?indA w)"
proof (rule integrable_real_mult_indicator)
show "Y -` (A∩ range Y) ∩ space M ∈ sets M" using yev by simp
show "integrable M (expl_cond_expect M Y ?Xp)" using posint by simp
qed
have exintn: "integrable M (λw. (expl_cond_expect M Y ?Xn w) * ?indA w)"
proof (rule integrable_real_mult_indicator)
show "Y -` (A∩ range Y) ∩ space M ∈ sets M" using yev by simp
show "integrable M (expl_cond_expect M Y ?Xn)" using negint by simp
qed
have "integral⇧L M (λw. X w * indicator (Y -` A ∩ space M) w) =
integral⇧L M (λw. (?Xp w - ?Xn w) * indicator (Y -` A ∩ space M) w)"
using ‹∀w. X w =?Xp w - ?Xn w› by auto
also have "... = integral⇧L M (λw. (?Xp w * indicator (Y -` A ∩ space M) w) - ?Xn w * indicator (Y -` A ∩ space M) w)"
by (simp add: left_diff_distrib)
also have "... = integral⇧L M (λw. (?Xp w * indicator (Y -` A ∩ space M) w)) -
integral⇧L M (λw. ?Xn w * indicator (Y -` A ∩ space M) w)"
using ‹Y -` A = Y -` (A ∩ range Y)› intp intn by auto
also have "... = integral⇧L M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A) ∩ (space M))) w) -
integral⇧L M (λw. ((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A) ∩ (space M))) w)"
using eqp eqn by (simp add: ‹A ∈ sets N›)
also have "... = integral⇧L M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A) ∩ (space M))) w -
((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A) ∩ (space M))) w)"
using ‹Y -` A = Y -` (A ∩ range Y)› exintn exintp by auto
also have "... = integral⇧L M (λw. ((expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A) ∩ (space M))) w)"
by (simp add: left_diff_distrib)
also have "... = integral⇧L M (λw. ((expl_cond_expect M Y (λx. ?Xp x - ?Xn x) w) * (indicator ((Y -`A) ∩ (space M))) w))"
using expl_cond_exp_diff[of M ?Xp ?Xn Y] ints by (metis (mono_tags, lifting) Bochner_Integration.integral_cong)
also have "... = integral⇧L M (λw. ((expl_cond_expect M Y X w) * (indicator ((Y -`A) ∩ (space M))) w))"
using ‹∀w. X w = ?Xp w - ?Xn w› expl_cond_exp_cong[of M X "λx. ?Xp x - ?Xn x" Y] by presburger
finally show "integral⇧L M (λw. X w * indicator (Y -` A ∩ space M) w) = integral⇧L M (λw. ((expl_cond_expect M Y X w) * (indicator ((Y -`A) ∩ (space M))) w))" .
qed
qed
lemma (in finite_measure) charact_cond_exp:
assumes "disc_fct Y"
and "integrable M X"
and "point_measurable M (space N) Y"
and "Y ∈ space M → space N"
and "∀r∈ range Y∩ space N. ∃A∈ sets N. range Y∩ A = {r}"
shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N Y) X w = expl_cond_expect M Y X w"
proof (rule sigma_finite_subalgebra.real_cond_exp_charact)
have "Y∈ measurable M N"
by (simp add: assms(1) assms(3) disct_fct_point_measurable)
have "point_measurable M (space N) Y" by (simp add: assms(3))
show "sigma_finite_subalgebra M (fct_gen_subalgebra M N Y)" unfolding sigma_finite_subalgebra_def
proof
show "subalgebra M (fct_gen_subalgebra M N Y)" using ‹Y∈ measurable M N› by (simp add: fct_gen_subalgebra_is_subalgebra)
show "sigma_finite_measure (restr_to_subalg M (fct_gen_subalgebra M N Y))" unfolding sigma_finite_measure_def
proof (intro exI conjI)
let ?A = "{space M}"
show "countable ?A" by simp
show "?A ⊆ sets (restr_to_subalg M (fct_gen_subalgebra M N Y))"
by (metis empty_subsetI insert_subset sets.top space_restr_to_subalg)
show "⋃ ?A = space (restr_to_subalg M (fct_gen_subalgebra M N Y))"
by (simp add: space_restr_to_subalg)
show "∀a∈{space M}. emeasure (restr_to_subalg M (fct_gen_subalgebra M N Y)) a ≠ ∞"
by (metis ‹subalgebra M (fct_gen_subalgebra M N Y)› emeasure_finite emeasure_restr_to_subalg infinity_ennreal_def sets.top singletonD subalgebra_def)
qed
qed
show "integrable M X" using assms by simp
show "expl_cond_expect M Y X ∈ borel_measurable (fct_gen_subalgebra M N Y)" using assms by (simp add:expl_cond_exp_borel)
show "integrable M (expl_cond_expect M Y X)"
using assms expl_cond_exp_integrable by blast
have "∀A∈ sets M. integral⇧L M (λw. (X w) * (indicator A w)) = set_lebesgue_integral M A X"
by (metis (no_types, lifting) Bochner_Integration.integral_cong mult_commute_abs real_scaleR_def set_lebesgue_integral_def)
have "∀A∈ sets M. integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator A w)) = set_lebesgue_integral M A (expl_cond_expect M Y X)"
by (metis (no_types, lifting) Bochner_Integration.integral_cong mult_commute_abs real_scaleR_def set_lebesgue_integral_def)
have "∀A∈ sets (fct_gen_subalgebra M N Y). integral⇧L M (λw. (X w) * (indicator A w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator A w))"
proof
fix A
assume "A ∈ sets (fct_gen_subalgebra M N Y)"
hence "A ∈ {Y -` B ∩ space M |B. B ∈ sets N}" using assms by (simp add:fct_gen_subalgebra_sigma_sets)
hence "∃B ∈ sets N. A = Y -`B ∩ space M" by auto
from this obtain B where "B∈ sets N" and "A = Y -`B∩ space M" by auto
thus "integral⇧L M (λw. (X w) * (indicator A w)) =
integral⇧L M (λw. ((expl_cond_expect M Y X) w) * (indicator A w))" using is_cond_exp
using Bochner_Integration.integral_cong ‹point_measurable M (space N) Y› assms(1) assms(2) by blast
qed
thus "⋀A. A ∈ sets (fct_gen_subalgebra M N Y) ⟹ set_lebesgue_integral M A X = set_lebesgue_integral M A (expl_cond_expect M Y X)"
by (smt Bochner_Integration.integral_cong Groups.mult_ac(2) real_scaleR_def set_lebesgue_integral_def)
qed
lemma (in finite_measure) charact_cond_exp':
assumes "disc_fct Y"
and "integrable M X"
and "Y∈ measurable M N"
and "∀r∈ range Y∩ space N. ∃A∈ sets N. range Y∩ A = {r}"
shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N Y) X w = expl_cond_expect M Y X w"
proof (rule charact_cond_exp)
show "disc_fct Y" using assms by simp
show "integrable M X" using assms by simp
show "∀r∈range Y ∩ space N. ∃A∈sets N. range Y ∩ A = {r}" using assms by simp
show "Y∈ space M → space N"
by (meson Pi_I assms(3) measurable_space)
show "point_measurable M (space N) Y" using assms by (simp add: meas_single_meas)
qed
end
Theory Infinite_Coin_Toss_Space
section ‹Infinite coin toss space›
text ‹This section contains the formalization of the infinite coin toss space, i.e., the probability
space constructed on infinite sequences of independent coin tosses.›
theory Infinite_Coin_Toss_Space imports Filtration Generated_Subalgebra Disc_Cond_Expect
begin
subsection ‹Preliminary results›
lemma decompose_init_prod:
fixes n::nat
shows "(∏ i∈ {0..n}. f i) = f 0 * (∏ i∈ {1..n}. f i)"
proof (cases "Suc 0 ≤ n")
case True
thus ?thesis
by (metis One_nat_def Suc_le_D True prod.atLeast0_atMost_Suc_shift prod.atLeast_Suc_atMost_Suc_shift)
next
case False
thus ?thesis
by (metis One_nat_def atLeastLessThanSuc_atLeastAtMost prod.atLeast0_lessThan_Suc_shift
prod.atLeast_Suc_lessThan_Suc_shift)
qed
lemma Inter_nonempty_distrib:
assumes "A ≠ {}"
shows "⋂A ∩ B = (⋂ C∈ A. (C∩ B))"
proof
show "(⋂C∈A. C ∩ B) ⊆ ⋂A ∩ B"
proof
fix x
assume mem: "x ∈ (⋂C∈A. C ∩ B)"
from ‹A ≠ {}› obtain C where "C∈ A" by blast
hence "x∈ C∩ B" using mem by blast
hence in1: "x∈ B" by auto
have "⋀C. C∈ A ⟹ x ∈ C∩B" using mem by blast
hence "⋀C. C∈ A ⟹ x∈ C" by auto
hence in2: "x∈ ⋂A" by auto
thus "x∈ ⋂A ∩ B" using in1 in2 by simp
qed
qed auto
lemma enn2real_sum: shows "finite A ⟹ (⋀a. a∈ A⟹ f a < top) ⟹enn2real (sum f A) = (∑ a∈ A. enn2real (f a))"
proof (induct rule:finite_induct)
case empty
thus ?case by simp
next
case (insert a A)
have "enn2real (sum f (insert a A)) = enn2real (f a + (sum f A))"
by (simp add: insert.hyps(1) insert.hyps(2))
also have "... = enn2real (f a) + enn2real (sum f A)"
by (simp add: enn2real_plus insert.hyps(1) insert.prems)
also have "... = enn2real (f a) + (∑ a∈ A. enn2real (f a))"
by (simp add: insert.hyps(3) insert.prems)
also have "... = (∑ a∈ (insert a A). enn2real (f a))"
by (metis calculation insert.hyps(1) insert.hyps(2) sum.insert)
finally show ?case .
qed
lemma ennreal_sum: shows "finite A ⟹ (⋀a. 0 ≤ f a) ⟹ (∑a∈ A. ennreal (f a)) = ennreal (∑a∈ A. f a)"
proof (induct rule:finite_induct)
case empty
thus ?case by simp
next
case (insert a A)
have "(∑a∈ (insert a A). ennreal (f a)) = ennreal (f a) + (∑a∈ A. ennreal (f a))"
by (simp add: insert.hyps(1) insert.hyps(2))
also have "... = ennreal (f a) + ennreal (∑a∈ A. f a)"
by (simp add: insert.prems)
also have "... = ennreal (f a + (∑a∈ A. f a))"
by (simp add: insert.prems sum_nonneg)
also have "... = ennreal (∑a∈ (insert a A). (f a))"
using insert.hyps(1) insert.hyps(2) by auto
finally show ?case .
qed
lemma stake_snth:
assumes "stake n w = stake n x"
shows "Suc i ≤ n ⟹ snth w i = snth x i"
by (metis Suc_le_eq assms stake_nth)
lemma stake_snth_charact:
assumes "stake n w = stake n x"
shows "∀i < n. snth w i = snth x i"
proof (intro allI impI)
fix i
assume "i < n"
thus "snth w i = snth x i" using Suc_leI assms stake_snth by blast
qed
lemma stake_snth':
shows "(⋀i. Suc i ≤ n ⟹ snth w i = snth x i) ⟹stake n w = stake n x"
proof (induct n arbitrary:w x)
case 0
then show ?case by auto
next
case (Suc n)
hence mh: "⋀i. Suc i ≤ Suc n ⟹ w !! i = x !! i" by auto
hence seq:"snth w n = snth x n" by auto
have "stake n w = stake n x" using mh Suc by (meson Suc_leD Suc_le_mono)
thus "stake (Suc n) w = stake (Suc n) x" by (metis seq stake_Suc)
qed
lemma stake_inter_snth:
fixes x
assumes "Suc 0 ≤ n"
shows "{w∈ space M. (stake n w = stake n x)} = (⋂ i ∈ {0.. n-1}. {w∈ space M. (snth w i = snth x i)})"
proof
let ?S = "{w∈ space M. (stake n w = stake n x)}"
show "?S ⊆ (⋂i∈{0..n-1}. {w ∈ space M. w !! i = x !! i})" using stake_snth assms by fastforce
show "(⋂i∈{0..n-1}. {w ∈ space M. w !! i = x !! i}) ⊆ ?S"
proof
fix w
assume inter: "w ∈ (⋂i∈{0..n-1}. {w ∈ space M. w !! i = x !! i})"
have "∀ i. 0 ≤ i ∧ i ≤ n-1 ⟶ snth w i = snth x i"
proof (intro allI impI)
fix i
assume "0 ≤ i ∧ i ≤ n-1"
thus "snth w i = snth x i" using inter by auto
qed
hence "stake n w = stake n x"
by (metis One_nat_def Suc_le_D diff_Suc_Suc diff_is_0_eq diff_zero le0 stake_snth')
thus "w∈ ?S" using inter by auto
qed
qed
lemma streams_stake_set:
shows "pw ∈ streams A ⟹ set (stake n pw) ⊆ A"
proof (induct n arbitrary: pw)
case (Suc n) note hyp = this
have "set (stake (Suc 0) pw) ⊆ A"
proof -
have "shd pw ∈ A" using hyp streams_shd[of pw A] by simp
have "stake (Suc 0) pw = [shd pw]" by auto
hence "set (stake (Suc 0) pw) = {shd pw}" by auto
thus ?thesis using ‹shd pw ∈ A› by auto
qed
thus ?case by (simp add: Suc.hyps Suc.prems streams_stl)
qed simp
lemma stake_finite_universe_induct:
assumes "finite A"
and "A ≠ {}"
shows "(stake (Suc n) `(streams A)) = {s#w| s w. s∈ A ∧ w∈ (stake n `(streams A))}" (is "?L = ?R")
proof
show "?L ⊆ ?R"
proof
fix l::"'a list"
assume "l∈ ?L"
hence "∃pw. pw ∈ streams A ∧ l = stake (Suc n) pw" by auto
from this obtain pw where "pw ∈ streams A" and "l = stake (Suc n) pw" by blast
hence "l = shd pw # stake n (stl pw)" unfolding stake_def by auto
thus "l∈ ?R" by (simp add: ‹pw ∈ streams A› streams_shd streams_stl)
qed
show "?R ⊆ ?L"
proof
fix l::"'a list"
assume "l∈ ?R"
hence "∃ s w. s∈ A ∧ w∈ (stake n `(streams A)) ∧ l = s# w" by auto
from this obtain s and w where "s∈ A" and "w∈ (stake n `(streams A))" and "l = s# w" by blast
note swprop = this
have "∃pw. pw ∈ streams A ∧ w = stake n pw" using swprop by auto
from this obtain pw where "pw∈ streams A" and "w = stake n pw" by blast note pwprop = this
have "l ∈ lists A"
proof -
have "s∈ A" using swprop by simp
have "set w ⊆ A" using pwprop streams_stake_set by simp
have "set l = set w ∪ {s}" using swprop by auto
thus ?thesis using ‹s∈ A› ‹set w ⊆ A› by auto
qed
have "∃x. x ∈ A" using assms by auto
from this obtain x where "x∈ A" by blast
let ?sx = "sconst x"
let ?st = "shift l ?sx"
have "l = stake (Suc n) ?st" by (simp add: pwprop(2) stake_shift swprop(3))
have "sset ?sx = {x}" by simp
hence "sset ?sx ⊆ A" using ‹x∈ A› by simp
hence "?sx ∈ streams A" using sset_streams[of "sconst x"] by simp
hence "?st ∈ streams A" using ‹l ∈ lists A› shift_streams[of l A "sconst x"] by simp
thus "l∈ ?L" using ‹l = stake (Suc n) ?st› by blast
qed
qed
lemma stake_finite_universe_finite:
assumes "finite A"
and "A ≠ {}"
shows "finite (stake n `(streams A))"
proof (induction n)
let ?L = "(stake 0 `(streams A))"
have "streams A ≠ {}"
proof
assume "streams A = {}"
have "∃x. x ∈ A" using assms by auto
from this obtain x where "x∈ A" by blast
let ?sx = "sconst x"
have "sset ?sx = {x}" by simp
hence "sset ?sx ⊆ A" using ‹x∈ A› by simp
hence "?sx ∈ streams A" using sset_streams[of "sconst x"] by simp
thus False using ‹streams A = {}› by simp
qed
have "stake 0 = (λs. [])" unfolding stake_def by simp
hence "?L = {[]}" using ‹streams A ≠ {}› by auto
show "finite (stake 0 `(streams A))" by (simp add: ‹?L = {[]}› image_constant_conv)
next
fix n assume "finite (stake n `(streams A))" note hyp = this
have "(stake (Suc n) `(streams A)) = {s#w| s w. s∈ A ∧ w∈ (stake n `(streams A))}" (is "?L = ?R")
using assms stake_finite_universe_induct[of A n] by simp
have "finite ?R" by (simp add: assms(1) finite_image_set2 hyp)
thus "finite ?L" using ‹?L = ?R›by simp
qed
lemma diff_streams_only_if:
assumes "w ≠ x"
shows "∃n. snth w n ≠ snth x n"
proof -
have f1: "smap (λn. x !! (n - Suc 0)) (fromN (Suc 0)) ≠ w"
by (metis assms stream_smap_fromN)
obtain nn :: "'a stream ⇒ nat stream ⇒ (nat ⇒ 'a) ⇒ nat" where
"∀x0 x1 x2. (∃v3. x2 (x1 !! v3) ≠ x0 !! v3) = (x2 (x1 !! nn x0 x1 x2) ≠ x0 !! nn x0 x1 x2)"
by moura
then have "x !! (fromN (Suc 0) !! nn w (fromN (Suc 0)) (λn. x !! (n - Suc 0)) - Suc 0) ≠ w !! nn w (fromN (Suc 0)) (λn. x !! (n - Suc 0))"
using f1 by (meson smap_alt)
then show ?thesis
by (metis (no_types) snth_smap stream_smap_fromN)
qed
lemma diff_streams_if:
assumes "∃n. snth w n ≠ snth x n"
shows "w≠ x"
using assms by auto
lemma sigma_set_union_count:
assumes "∀ y∈ A. B y ∈ sigma_sets X Y"
and "countable A"
shows "(⋃ y∈ A. B y) ∈ sigma_sets X Y"
by (metis (mono_tags, lifting) assms countable_image imageE sigma_sets_UNION)
lemma sigma_set_inter_init:
assumes "⋀i. i≤(n::nat) ⟹ A i ∈ sigma_sets sp B"
and "B ⊆ Pow sp"
shows "(⋂ i∈ {m. m≤ n}. A i) ∈ sigma_sets sp B"
by (metis (full_types) assms(1) assms(2) bot.extremum empty_iff mem_Collect_eq sigma_sets_INTER)
lemma adapt_sigma_sets:
assumes "⋀i. i ≤ n⟹ (X i) ∈ measurable M N"
shows "sigma_algebra (space M) (sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}))"
proof (rule sigma_algebra_sigma_sets)
show "(⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}) ⊆ Pow (space M)"
proof (rule UN_subset_iff[THEN iffD2], intro ballI)
fix i
assume "i ∈ {m. m≤ n}"
show "{X i -` A ∩ space M |A. A ∈ sets N} ⊆ Pow (space M)" by auto
qed
qed
subsection ‹Bernoulli streams›
text ‹Bernoulli streams represent the formal definition of the infinite coin toss space. The parameter
‹p› represents the probability of obtaining a head after a coin toss.›
definition bernoulli_stream::"real ⇒ (bool stream) measure" where
"bernoulli_stream p = stream_space (measure_pmf (bernoulli_pmf p))"
lemma bernoulli_stream_space:
assumes "N = bernoulli_stream p"
shows "space N = streams UNIV::bool"
using assms unfolding bernoulli_stream_def stream_space_def
by (simp add: assms bernoulli_stream_def space_stream_space)
lemma bernoulli_stream_preimage:
assumes "N = bernoulli_stream p"
shows "f -` A ∩ (space N) = f-`A"
using assms by (simp add: bernoulli_stream_space)
lemma bernoulli_stream_component_probability:
assumes "N = bernoulli_stream p" and "0 ≤ p" and "p ≤ 1"
shows "∀ n. emeasure N {w∈ space N. (snth w n)} = p"
proof
have "prob_space N" using assms by (simp add: bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
fix n::nat
let ?S = "{w∈ space N. (snth w n)}"
have s: "?S ∈ sets N"
proof -
have "(λw. snth w n) ∈ measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
moreover have "{True} ∈ sets (measure_pmf (bernoulli_pmf p))" by simp
ultimately show ?thesis by simp
qed
let ?PM = "(λi::nat. (measure_pmf (bernoulli_pmf p)))"
have isps: "product_prob_space ?PM" by unfold_locales
let ?Z = "{X::nat⇒bool. X n = True}"
let ?wPM = "Pi⇩M UNIV ?PM"
have "space ?wPM = UNIV" using space_PiM by fastforce
hence "(to_stream -` ?S ∩ (space ?wPM)) = to_stream -` ?S" by simp
also have "... = ?Z" using assms by (simp add:bernoulli_stream_space to_stream_def)
also have "... = prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True}))"
proof
{
fix X
assume "X ∈ prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True}))"
hence "restrict X {n} ∈ (Pi⇩E {n} (λx::nat. {True}))" using prod_emb_iff[of X] by simp
hence "X n = True"
unfolding PiE_iff by auto
hence "X ∈ ?Z" by simp
}
thus "prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True})) ⊆ ?Z" by auto
{
fix X
assume "X ∈ ?Z"
hence "X n = True" by simp
hence "restrict X {n} ∈ (Pi⇩E {n} (λx::nat. {True}))"
unfolding PiE_iff by auto
moreover have "X ∈ extensional UNIV" by simp
moreover have "∀i ∈ UNIV. X i ∈ space (?PM i)" by auto
ultimately have "X ∈ prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True}))" using prod_emb_iff[of X] by simp
}
thus "?Z ⊆ prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True}))" by auto
qed
finally have inteq: "(to_stream -` ?S ∩ (space ?wPM)) = prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True}))" .
have "emeasure N ?S = emeasure ?wPM (to_stream -` ?S ∩ (space ?wPM))"
using assms emeasure_distr[of "to_stream" ?wPM "(vimage_algebra (streams (space (measure_pmf (bernoulli_pmf p)))) (!!)
(Pi⇩M UNIV (λi. measure_pmf (bernoulli_pmf p))))" ?S] measurable_to_stream[of "(measure_pmf (bernoulli_pmf p))"] s
unfolding bernoulli_stream_def stream_space_def by auto
also have "... = emeasure ?wPM (prod_emb UNIV ?PM {n} (Pi⇩E {n} (λx::nat. {True})))" using inteq by simp
also have "... =
(∏i∈{n}. emeasure (?PM i) ((λx::nat. {True}) i))" using isps
by (auto simp add: product_prob_space.emeasure_PiM_emb simp del: ext_funcset_to_sing_iff)
also have "... = emeasure (?PM n) {True}" by simp
also have "... = p" using assms by (simp add: emeasure_pmf_single)
finally show "emeasure N ?S = p" .
qed
lemma bernoulli_stream_component_probability_compl:
assumes "N = bernoulli_stream p" and "0 ≤ p" and "p ≤ 1"
shows "∀ n. emeasure N {w∈ space N. ¬(snth w n)} = 1- p"
proof
fix n
let ?A = "{w ∈ space N. ¬ w !! n}"
let ?B = "{w ∈ space N. w !! n}"
have "?A ∪ ?B = space N" by auto
have "?A∩?B = {}" by auto
hence eqA: "?A = (?A∪ ?B) - ?B" using Diff_cancel by blast
moreover have "?A ∈ sets N"
proof -
have "(λw. snth w n) ∈ measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
moreover have "{True} ∈ sets (measure_pmf (bernoulli_pmf p))" by simp
ultimately show ?thesis by simp
qed
moreover have "?B ∈ sets N"
proof -
have "(λw. snth w n) ∈ measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
moreover have "{True} ∈ sets (measure_pmf (bernoulli_pmf p))" by simp
ultimately show ?thesis by simp
qed
ultimately have "emeasure N ((?A∪ ?B) - ?B) = emeasure N (?A∪ ?B) - emeasure N ?B"
proof -
have f1: "⋀S m. (S::bool stream set) ∉ sets m ∨ emeasure m S = ⊤ ∨ emeasure m (space m) - emeasure m S = emeasure m (space m - S)"
by (metis emeasure_compl infinity_ennreal_def)
have "emeasure N {s ∈ space N. s !! n} ≠ ⊤"
using assms(1) assms(2) assms(3) ennreal_neq_top bernoulli_stream_component_probability by presburger
then have "emeasure N (space N) - emeasure N {s ∈ space N. s !! n} = emeasure N (space N - {s ∈ space N. s !! n})"
using f1 ‹{w ∈ space N. w !! n} ∈ sets N› by blast
then show ?thesis
using ‹{w ∈ space N. ¬ w !! n} ∪ {w ∈ space N. w !! n} = space N› by presburger
qed
hence "emeasure N ?A = emeasure N (?A∪ ?B) - emeasure N ?B" using eqA by simp
also have "... = 1 - emeasure N ?B"
by (metis (no_types, lifting) ‹?A ∪ ?B = space N› assms(1) bernoulli_stream_def
prob_space.emeasure_space_1 prob_space.prob_space_stream_space prob_space_measure_pmf)
also have "... = 1 - p" using bernoulli_stream_component_probability[of N p] assms
by (metis (mono_tags) ennreal_1 ennreal_minus_if)
finally show "emeasure N ?A = 1 - p" .
qed
lemma bernoulli_stream_sets:
assumes "0 < q"
and "q < 1"
and "0 < p"
and "p < 1"
shows "sets (bernoulli_stream p) = sets (bernoulli_stream q)" unfolding bernoulli_stream_def
by (rule sets_stream_space_cong, simp)
locale infinite_coin_toss_space =
fixes p::real and M::"bool stream measure"
assumes p_gt_0: "0 ≤ p"
and p_lt_1: "p ≤ 1"
and bernoulli: "M = bernoulli_stream p"
sublocale infinite_coin_toss_space ⊆ prob_space
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
subsection ‹Natural filtration on the infinite coin toss space›
text ‹The natural filtration on the infinite coin toss space is the discrete filtration @{term F}
such that @{term "F n"} represents the restricted measure space in which the outcome of the first
@{term n} coin tosses is known.›
subsubsection ‹The projection function›
text ‹Intuitively, the restricted measure space in which the outcome of the first @{term n} coin tosses is known
can be defined by any measurable function that maps all infinite sequences that agree on the first
@{term n} coin tosses to the same element.›
definition (in infinite_coin_toss_space) pseudo_proj_True:: "nat ⇒ bool stream ⇒ bool stream" where
"pseudo_proj_True n = (λw. shift (stake n w) (sconst True))"
definition (in infinite_coin_toss_space) pseudo_proj_False:: "nat ⇒ bool stream ⇒ bool stream" where
"pseudo_proj_False n = (λw. shift (append (stake n w) [False]) (sconst True))"
lemma (in infinite_coin_toss_space) pseudo_proj_False_neq_True:
shows "pseudo_proj_False n w ≠ pseudo_proj_True n w"
proof (rule diff_streams_if, intro exI)
have "snth (pseudo_proj_False n w) n = False" unfolding pseudo_proj_False_def by simp
moreover have "snth (pseudo_proj_True n w) n = True" unfolding pseudo_proj_True_def by simp
ultimately show "snth (pseudo_proj_False n w) n ≠ snth (pseudo_proj_True n w) n" by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_False_measurable:
shows "pseudo_proj_False n ∈ measurable (bernoulli_stream p) (bernoulli_stream p)"
proof -
let ?N = "bernoulli_stream p"
have "id ∈ measurable ?N ?N" by simp
moreover have "(λw. (sconst True)) ∈ measurable ?N ?N" using bernoulli_stream_space by simp
ultimately show ?thesis using measurable_shift p_gt_0 p_lt_1
unfolding bernoulli_stream_def pseudo_proj_False_def by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_stake:
shows "stake n (pseudo_proj_True n w) = stake n w" by (simp add: pseudo_proj_True_def stake_shift)
lemma (in infinite_coin_toss_space) pseudo_proj_False_stake:
shows "stake n (pseudo_proj_False n w) = stake n w" by (simp add: pseudo_proj_False_def stake_shift)
lemma (in infinite_coin_toss_space) pseudo_proj_True_stake_image:
assumes "(stake n w) = stake n x"
shows "pseudo_proj_True n w = pseudo_proj_True n x" by (simp add: assms pseudo_proj_True_def)
lemma (in infinite_coin_toss_space) pseudo_proj_True_prefix:
assumes "n ≤ m"
and "pseudo_proj_True m x = pseudo_proj_True m y"
shows "pseudo_proj_True n x = pseudo_proj_True n y"
by (metis assms diff_is_0_eq id_stake_snth_sdrop length_stake pseudo_proj_True_def stake.simps(1) stake_shift)
lemma (in infinite_coin_toss_space) pseudo_proj_True_measurable:
shows "pseudo_proj_True n ∈ measurable (bernoulli_stream p) (bernoulli_stream p)"
proof -
let ?N = "bernoulli_stream p"
have "id ∈ measurable ?N ?N" by simp
moreover have "(λw. (sconst True)) ∈ measurable ?N ?N" using bernoulli_stream_space by simp
ultimately show ?thesis using measurable_shift p_gt_0 p_lt_1
unfolding bernoulli_stream_def pseudo_proj_True_def by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_finite_image:
shows "finite (range (pseudo_proj_True n))"
proof -
let ?U = "UNIV::bool set"
have "?U = {True, False}" by auto
hence "finite ?U" by simp
moreover have "?U ≠ {}" by auto
ultimately have fi: "finite (stake n `streams ?U)" using stake_finite_universe_finite[of ?U] by simp
let ?sh= "(λl. shift l (sconst True))"
have "finite {?sh l|l. l∈(stake n `streams ?U)}" using fi by simp
moreover have "{?sh l|l. l∈(stake n `streams ?U)} = range (pseudo_proj_True n)" unfolding pseudo_proj_True_def by auto
ultimately show ?thesis by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_False_finite_image:
shows "finite (range (pseudo_proj_False n))"
proof -
let ?U = "UNIV::bool set"
have "?U = {True, False}" by auto
hence "finite ?U" by simp
moreover have "?U ≠ {}" by auto
ultimately have fi: "finite (stake n `streams ?U)" using stake_finite_universe_finite[of ?U] by simp
let ?sh= "(λl. shift (l @ [False]) (sconst True))"
have "finite {?sh l|l. l∈(stake n `streams ?U)}" using fi by simp
moreover have "{?sh l|l. l∈(stake n `streams ?U)} = range (pseudo_proj_False n)" unfolding pseudo_proj_False_def by auto
ultimately show ?thesis by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_proj:
shows "pseudo_proj_True n (pseudo_proj_True n w) = pseudo_proj_True n w"
by (metis pseudo_proj_True_def pseudo_proj_True_stake)
lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_False_proj:
shows "pseudo_proj_True (Suc n) (pseudo_proj_False n w) = pseudo_proj_False n w"
by (metis append_Nil2 cancel_comm_monoid_add_class.diff_cancel length_append_singleton length_stake order_refl pseudo_proj_False_def pseudo_proj_True_def stake.simps(1) stake_shift take_all)
lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_proj:
shows "pseudo_proj_True (Suc n) (pseudo_proj_True n w) = pseudo_proj_True n w"
by (metis id_apply id_stake_snth_sdrop pseudo_proj_True_def pseudo_proj_True_stake shift_left_inj siterate.code stake_sdrop stream.sel(2))
lemma (in infinite_coin_toss_space) pseudo_proj_True_proj_Suc:
shows "pseudo_proj_True n (pseudo_proj_True (Suc n) w) = pseudo_proj_True n w"
by (meson Suc_n_not_le_n nat_le_linear pseudo_proj_True_prefix pseudo_proj_True_stake pseudo_proj_True_stake_image)
lemma (in infinite_coin_toss_space) pseudo_proj_True_shift:
shows "length l = n ⟹ pseudo_proj_True n (shift l (sconst True)) = shift l (sconst True)"
by (simp add: pseudo_proj_True_def stake_shift)
lemma (in infinite_coin_toss_space) pseudo_proj_True_suc_img:
shows "pseudo_proj_True (Suc n) w ∈ {pseudo_proj_True n w, pseudo_proj_False n w}"
by (metis (full_types) cycle_decomp insertCI list.distinct(1) pseudo_proj_True_def pseudo_proj_False_def sconst_cycle shift_append stake_Suc)
lemma (in infinite_coin_toss_space) measurable_snth_count_space:
shows "(λw. snth w n) ∈ measurable (bernoulli_stream p) (count_space (UNIV::bool set))"
by (simp add: bernoulli_stream_def)
lemma (in infinite_coin_toss_space) pseudo_proj_True_same_img:
assumes "pseudo_proj_True n w = pseudo_proj_True n x"
shows "stake n w = stake n x" by (metis assms pseudo_proj_True_stake)
lemma (in infinite_coin_toss_space) pseudo_proj_True_snth:
assumes "pseudo_proj_True n x = pseudo_proj_True n w"
shows "⋀i. Suc i ≤ n ⟹ snth x i = snth w i"
proof -
fix i
have "stake n w= stake n x" using assms by (metis pseudo_proj_True_stake)
assume "Suc i ≤ n"
thus "snth x i = snth w i" using ‹stake n w = stake n x› stake_snth by auto
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_snth':
assumes "(⋀i. Suc i ≤ n ⟹ snth w i = snth x i)"
shows "pseudo_proj_True n w = pseudo_proj_True n x"
proof -
have "stake n w = stake n x" using stake_snth'[of n w x] using assms by simp
moreover have "stake n w = stake n x ⟹ pseudo_proj_True n w = pseudo_proj_True n x" using pseudo_proj_True_stake_image[of n w x] by simp
ultimately show ?thesis by auto
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage:
assumes "w = pseudo_proj_True n w"
shows "(pseudo_proj_True n) -` {w} = (⋂i∈ {m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
proof
show "(pseudo_proj_True n) -` {w} ⊆ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
proof
fix x
assume "x ∈ (pseudo_proj_True n) -`{w}"
hence "pseudo_proj_True n x = pseudo_proj_True n w" using assms by auto
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ x ∈ (λx. snth x i) -`{snth w i}"
by (metis (mono_tags) Suc_le_eq mem_Collect_eq
pseudo_proj_True_stake stake_nth vimage_singleton_eq)
thus "x ∈ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})" by auto
qed
show "(⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i}) ⊆ (pseudo_proj_True n) -` {w}"
proof
fix x
assume "x∈ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ x ∈ (λx. snth x i) -`{snth w i}" by simp
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ snth x i = snth w i" by simp
hence "⋀i. Suc i ≤ n ⟹ snth x i = snth w i" by auto
hence "pseudo_proj_True n x = pseudo_proj_True n w" using pseudo_proj_True_snth'[of n x w] by simp
also have "... = w" using assms by simp
finally have "pseudo_proj_True n x = w" .
thus "x ∈ (pseudo_proj_True n) -`{w}" by auto
qed
qed
lemma (in infinite_coin_toss_space) pseudo_proj_False_preimage:
assumes "w = pseudo_proj_False n w"
shows "(pseudo_proj_False n) -` {w} = (⋂i∈ {m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
proof
show "(pseudo_proj_False n) -` {w} ⊆ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
proof
fix x
assume "x ∈ (pseudo_proj_False n) -`{w}"
hence "pseudo_proj_False n x = pseudo_proj_False n w" using assms by auto
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ x ∈ (λx. snth x i) -`{snth w i}"
by (metis (mono_tags) Suc_le_eq mem_Collect_eq
pseudo_proj_False_stake stake_nth vimage_singleton_eq)
thus "x ∈ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})" by auto
qed
show "(⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i}) ⊆ (pseudo_proj_False n) -` {w}"
proof
fix x
assume "x∈ (⋂i∈{m. Suc m ≤ n}. (λw. snth w i) -` {snth w i})"
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ x ∈ (λx. snth x i) -`{snth w i}" by simp
hence "⋀i. i ∈{m. Suc m ≤ n} ⟹ snth x i = snth w i" by simp
hence "⋀i. Suc i ≤ n ⟹ snth x i = snth w i" by auto
hence "pseudo_proj_False n x = pseudo_proj_False n w"
by (metis (full_types) pseudo_proj_False_def stake_snth')
also have "... = w" using assms by simp
finally have "pseudo_proj_False n x = w" .
thus "x ∈ (pseudo_proj_False n) -`{w}" by auto
qed
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage_stake:
assumes "w = pseudo_proj_True n w"
shows "(pseudo_proj_True n) -` {w} = {x. stake n x = stake n w}"
proof
show "{x. stake n x = stake n w} ⊆ (pseudo_proj_True n) -` {w}"
proof
fix x
assume "x ∈ {x. stake n x = stake n w}"
hence "stake n x = stake n w" by auto
hence "pseudo_proj_True n x = w" using assms pseudo_proj_True_def by auto
thus "x ∈ (pseudo_proj_True n) -` {w}" by auto
qed
show "(pseudo_proj_True n) -` {w} ⊆ {x. stake n x = stake n w}"
proof
fix x
assume "x∈ pseudo_proj_True n -`{w}"
hence "pseudo_proj_True n x = pseudo_proj_True n w" using assms by auto
hence "stake n x = stake n w" by (metis pseudo_proj_True_stake)
thus "x∈ {x. stake n x = stake n w}" by simp
qed
qed
lemma (in infinite_coin_toss_space) pseudo_proj_False_preimage_stake:
assumes "w = pseudo_proj_False n w"
shows "(pseudo_proj_False n) -` {w} = {x. stake n x = stake n w}"
proof
show "{x. stake n x = stake n w} ⊆ (pseudo_proj_False n) -` {w}"
proof
fix x
assume "x ∈ {x. stake n x = stake n w}"
hence "stake n x = stake n w" by auto
hence "pseudo_proj_False n x = w" using assms pseudo_proj_False_def by auto
thus "x ∈ (pseudo_proj_False n) -` {w}" by auto
qed
show "(pseudo_proj_False n) -` {w} ⊆ {x. stake n x = stake n w}"
proof
fix x
assume "x∈ pseudo_proj_False n -`{w}"
hence "pseudo_proj_False n x = pseudo_proj_False n w" using assms by auto
hence "stake n x = stake n w" by (metis pseudo_proj_False_stake)
thus "x∈ {x. stake n x = stake n w}" by simp
qed
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage_stake_space:
assumes "w = pseudo_proj_True n w"
shows "(pseudo_proj_True n) -` {w} ∩ space M = {x∈ space M. stake n x = stake n w}"
proof -
have "(pseudo_proj_True n) -` {w} = {x. stake n x = stake n w}" using assms
by (simp add:pseudo_proj_True_preimage_stake)
hence "(pseudo_proj_True n) -` {w}∩ space M = {x. stake n x = stake n w}∩ space M"
by simp
also have "... = {x∈ space M. stake n x = stake n w}" by auto
finally show ?thesis .
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_singleton:
assumes "w = pseudo_proj_True n w"
shows "(pseudo_proj_True n) -`{w} ∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
proof (cases "{m. (Suc m) ≤ n} = {}")
case False
have "⋀i. (λx. snth x i) ∈ measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
have fi: "⋀i. Suc i ≤ n ⟹ (λw. snth w i) -` {snth w i} ∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
proof -
fix i
assume "Suc i ≤ n"
have "(λx. snth x i) ∈ measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
moreover have "{snth w i} ∈ sets (count_space UNIV)" by auto
ultimately show "(λx. snth x i) -` {snth w i}∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
unfolding measurable_def by (simp add: measurable_snth_count_space)
qed
have "(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i}∩ (space (bernoulli_stream p))) ∈ sets (bernoulli_stream p)"
proof ((rule sigma_algebra.countable_INT''), auto)
show "sigma_algebra (space (bernoulli_stream p)) (sets (bernoulli_stream p))"
using measure_space measure_space_def by auto
show "UNIV ∈ sets (bernoulli_stream p)" by (metis bernoulli_stream_space sets.top streams_UNIV)
show "⋀i. Suc i ≤ n ⟹ (λw. w !! i) -` {w !! i} ∩ space (bernoulli_stream p) ∈ sets (bernoulli_stream p)" using fi by simp
qed
moreover have "(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i}∩ (space (bernoulli_stream p))) =
(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i})∩ (space (bernoulli_stream p))"
using False Inter_nonempty_distrib by auto
ultimately show ?thesis using assms pseudo_proj_True_preimage[of w n] by simp
next
case True
hence "n = 0" using less_eq_Suc_le by auto
hence "pseudo_proj_True n = (λw. sconst True)" by (simp add: pseudo_proj_True_def)
hence "w = sconst True" using assms by simp
hence "(pseudo_proj_True n) -`{w} ∩ (space (bernoulli_stream p)) = (space (bernoulli_stream p))" by (simp add: ‹pseudo_proj_True n = (λw. sconst True)›)
thus "(pseudo_proj_True n) -`{w} ∩ (space (bernoulli_stream p))∈ sets (bernoulli_stream p)" by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_False_singleton:
assumes "w = pseudo_proj_False n w"
shows "(pseudo_proj_False n) -`{w} ∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
proof (cases "{m. (Suc m) ≤ n} = {}")
case False
have "⋀i. (λx. snth x i) ∈ measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
have fi: "⋀i. Suc i ≤ n ⟹ (λw. snth w i) -` {snth w i} ∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
proof -
fix i
assume "Suc i ≤ n"
have "(λx. snth x i) ∈ measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
moreover have "{snth w i} ∈ sets (count_space UNIV)" by auto
ultimately show "(λx. snth x i) -` {snth w i}∩ (space (bernoulli_stream p)) ∈ sets (bernoulli_stream p)"
unfolding measurable_def by (simp add: measurable_snth_count_space)
qed
have "(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i}∩ (space (bernoulli_stream p))) ∈ sets (bernoulli_stream p)"
proof ((rule sigma_algebra.countable_INT''), auto)
show "sigma_algebra (space (bernoulli_stream p)) (sets (bernoulli_stream p))"
using measure_space measure_space_def by auto
show "UNIV ∈ sets (bernoulli_stream p)" by (metis bernoulli_stream_space sets.top streams_UNIV)
show "⋀i. Suc i ≤ n ⟹ (λw. w !! i) -` {w !! i} ∩ space (bernoulli_stream p) ∈ sets (bernoulli_stream p)" using fi by simp
qed
moreover have "(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i}∩ (space (bernoulli_stream p))) =
(⋂i∈ {m. (Suc m) ≤ n}. (λw. snth w i) -` {snth w i})∩ (space (bernoulli_stream p))"
using False Inter_nonempty_distrib by auto
ultimately show ?thesis using assms pseudo_proj_False_preimage[of w n] by simp
next
case True
hence "n = 0" using less_eq_Suc_le by auto
hence "pseudo_proj_False n = (λw. False ## sconst True)" by (simp add: pseudo_proj_False_def)
hence "w = False ## sconst True" using assms by simp
hence "(pseudo_proj_False n) -`{w} ∩ (space (bernoulli_stream p)) = (space (bernoulli_stream p))"
by (simp add: ‹pseudo_proj_False n = (λw. False##sconst True)›)
thus "(pseudo_proj_False n) -`{w} ∩ (space (bernoulli_stream p))∈ sets (bernoulli_stream p)" by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_inverse_induct:
assumes "w ∈ range (pseudo_proj_True n)"
shows "(pseudo_proj_True n) -` {w} =
(pseudo_proj_True (Suc n)) -` {w} ∪ (pseudo_proj_True (Suc n)) -`{pseudo_proj_False n w}"
proof
let ?y = "pseudo_proj_False n w"
show "(pseudo_proj_True n) -` {w} ⊆ (pseudo_proj_True (Suc n)) -` {w} ∪ (pseudo_proj_True (Suc n)) -`{?y}"
proof
fix z
assume "z∈ pseudo_proj_True n -`{w}"
thus "z∈ pseudo_proj_True (Suc n) -`{w} ∪ pseudo_proj_True (Suc n) -`{?y}"
using pseudo_proj_False_def pseudo_proj_True_def pseudo_proj_True_stake
pseudo_proj_True_suc_img by fastforce
qed
{
fix z
assume "z ∈ pseudo_proj_True (Suc n) -` {w}"
hence "pseudo_proj_True (Suc n) z = w" by simp
hence "pseudo_proj_True n z = pseudo_proj_True n w" by (metis pseudo_proj_True_proj_Suc)
also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
finally have "pseudo_proj_True n z = w" .
}
hence fst: "pseudo_proj_True (Suc n) -` {w} ⊆ (pseudo_proj_True n) -` {w}" by blast
{
fix z
assume "z ∈ pseudo_proj_True (Suc n) -` {?y}"
hence "pseudo_proj_True n z = pseudo_proj_True n w"
by (metis append1_eq_conv append_Nil2 cancel_comm_monoid_add_class.diff_cancel
length_append_singleton length_stake order_refl pseudo_proj_False_def
pseudo_proj_True_stake pseudo_proj_True_stake_image stake_Suc stake_invert_Nil stake_shift
take_all vimage_singleton_eq)
also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
finally have "pseudo_proj_True n z = w" .
}
hence scd: "pseudo_proj_True (Suc n) -` {?y} ⊆ (pseudo_proj_True n) -` {w}" by blast
show "(pseudo_proj_True (Suc n)) -` {w} ∪ (pseudo_proj_True (Suc n)) -`{?y} ⊆ (pseudo_proj_True n) -` {w}"
using fst scd by auto
qed
subsubsection ‹Natural filtration locale›
text ‹This part is mainly devoted to the proof that the projection function defined above indeed
permits to obtain a filtration on the infinite coin toss space, and that this filtration is initially trivial.›
definition (in infinite_coin_toss_space) nat_filtration::"nat ⇒ bool stream measure" where
"nat_filtration n = fct_gen_subalgebra M M (pseudo_proj_True n)"
locale infinite_cts_filtration = infinite_coin_toss_space +
fixes F
assumes natural_filtration: "F = nat_filtration"
lemma (in infinite_coin_toss_space) nat_filtration_space:
shows "space (nat_filtration n) = UNIV"
by (metis bernoulli bernoulli_stream_space fct_gen_subalgebra_space nat_filtration_def streams_UNIV)
lemma (in infinite_coin_toss_space) nat_filtration_sets:
shows "sets (nat_filtration n) =
sigma_sets (space (bernoulli_stream p))
{pseudo_proj_True n -` B ∩ space M |B. B ∈ sets (bernoulli_stream p)}"
proof -
have "sigma_sets (space M) {pseudo_proj_True n -` S ∩ space M |S. S ∈ sets (bernoulli_stream p)} =
sets (fct_gen_subalgebra M M (pseudo_proj_True n))"
using bernoulli fct_gen_subalgebra_sets pseudo_proj_True_measurable by blast
then show ?thesis
using bernoulli nat_filtration_def by force
qed
lemma (in infinite_coin_toss_space) nat_filtration_singleton:
assumes "pseudo_proj_True n w = w"
shows "pseudo_proj_True n -`{w} ∈ sets (nat_filtration n)"
proof -
let ?pw = "pseudo_proj_True n -`{w}"
have memset:"?pw ∈ sets M" using bernoulli assms bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"]
pseudo_proj_True_singleton[of w n] by simp
have "pseudo_proj_True n -`?pw ∈ sets (nat_filtration n)"
proof -
have "pseudo_proj_True n -`?pw ∩ (space M) ∈ sets (nat_filtration n)" using memset
by (metis fct_gen_subalgebra_sets_mem nat_filtration_def)
moreover have "pseudo_proj_True n -`?pw ∩ (space M) = pseudo_proj_True n -`?pw" using
bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"] bernoulli by simp
ultimately show "pseudo_proj_True n -`?pw ∈ sets (nat_filtration n)" by auto
qed
moreover have "pseudo_proj_True n -`?pw = ?pw" using pseudo_proj_True_proj by auto
ultimately show ?thesis by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_pseudo_proj_True_measurable:
shows "pseudo_proj_True n ∈ measurable (nat_filtration n) M" unfolding nat_filtration_def
using bernoulli fct_gen_subalgebra_fct_measurable[of "pseudo_proj_True n" M M] pseudo_proj_True_measurable[of n]
bernoulli_stream_space by auto
lemma (in infinite_coin_toss_space) nat_filtration_comp_measurable:
assumes "f ∈ measurable M N"
and "f ∘ pseudo_proj_True n = f"
shows "f ∈ measurable (nat_filtration n) N"
by (metis assms measurable_comp nat_filtration_pseudo_proj_True_measurable)
definition (in infinite_coin_toss_space) set_discriminating where
"set_discriminating n f N ≡ (∀w. f w ≠ f (pseudo_proj_True n w) ⟶
(∃A∈sets N. (f w ∈ A) = (f (pseudo_proj_True n w) ∉ A)))"
lemma (in infinite_coin_toss_space) set_discriminating_if:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "set_discriminating n f borel" unfolding set_discriminating_def
proof (intro allI impI)
{
fix w
assume "f w ≠ (f ∘ (pseudo_proj_True n)) w"
hence "∃U. open U ∧ ( f w ∈ U = ((f ∘ (pseudo_proj_True n)) w ∉ U))" using separation_t0 by auto
from this obtain A where "open A" and "f w∈ A = ((f ∘ (pseudo_proj_True n)) w ∉ A)" by blast note Ah = this
have "A∈ sets borel" using Ah by simp
hence "∃A∈sets borel. (f w ∈ A) = ((f ∘ (pseudo_proj_True n)) w ∉ A)" using Ah by blast
}
thus "⋀w. f w ≠ f (pseudo_proj_True n w) ⟹ ∃A∈sets borel. (f w ∈ A) = (f (pseudo_proj_True n w) ∉ A)" by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_not_borel_info:
assumes "f∈ measurable (nat_filtration n) N"
and "set_discriminating n f N"
shows "f∘ pseudo_proj_True n = f"
proof (rule ccontr)
assume "f∘ pseudo_proj_True n ≠ f"
hence "∃ w. (f∘ (pseudo_proj_True n)) w ≠ f w" by auto
from this obtain w where "(f∘ (pseudo_proj_True n)) w ≠ f w" by blast note wh = this
let ?x = "pseudo_proj_True n w"
have "pseudo_proj_True n ?x = pseudo_proj_True n w" by (simp add: pseudo_proj_True_proj)
have "f w ≠ f (pseudo_proj_True n w)" using wh by simp
hence "∃A ∈ sets N. ( f w ∈ A = (f ?x ∉ A))" using assms unfolding set_discriminating_def by simp
from this obtain A where "A ∈ sets N" and "f w∈ A = (f ?x ∉ A)" by blast note Ah = this
have "f-` A∩ (space (nat_filtration n)) ∈ sets (nat_filtration n)"
using Ah assms borel_open measurable_sets by blast
hence fn:"f-` A ∈ sets (nat_filtration n)" using nat_filtration_space by simp
have "?x∈ f-`A = (w ∈ f -`A)" using ‹pseudo_proj_True n ?x = pseudo_proj_True n w› assms
fct_gen_subalgebra_info[of "pseudo_proj_True n" M] bernoulli_stream_space
by (metis Pi_I UNIV_I bernoulli fn nat_filtration_def streams_UNIV)
also have "... = (f w ∈ A)" by simp
also have "... = (f ?x ∉ A)" using Ah by simp
also have "... = (?x ∉ f -`A)" by simp
finally have "?x∈ f-`A = (?x ∉ f -`A)" .
thus False by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_info:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "f∘ pseudo_proj_True n = f"
proof (rule nat_filtration_not_borel_info)
show "f∈ borel_measurable (nat_filtration n)" using assms by simp
show "set_discriminating n f borel" using assms by (simp add: set_discriminating_if)
qed
lemma (in infinite_coin_toss_space) nat_filtration_not_borel_info':
assumes "f∈ measurable (nat_filtration n) N"
and "set_discriminating n f N"
shows "f∘ pseudo_proj_False n = f"
proof
fix x
have "(f ∘ pseudo_proj_False n) x = f (pseudo_proj_False n x)" by simp
also have "... = f (pseudo_proj_True n (pseudo_proj_False n x))" using assms nat_filtration_not_borel_info
by (metis comp_apply)
also have "... = f (pseudo_proj_True n x)"
proof -
have "pseudo_proj_True n (pseudo_proj_False n x) = pseudo_proj_True n x"
by (simp add: pseudo_proj_False_stake pseudo_proj_True_def)
thus ?thesis by simp
qed
also have "... = f x" using assms nat_filtration_not_borel_info by (metis comp_apply)
finally show "(f ∘ pseudo_proj_False n) x = f x" .
qed
lemma (in infinite_coin_toss_space) nat_filtration_info':
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "f∘ pseudo_proj_False n = f"
proof
fix x
have "(f ∘ pseudo_proj_False n) x = f (pseudo_proj_False n x)" by simp
also have "... = f (pseudo_proj_True n (pseudo_proj_False n x))" using assms nat_filtration_info
by (metis comp_apply)
also have "... = f (pseudo_proj_True n x)"
proof -
have "pseudo_proj_True n (pseudo_proj_False n x) = pseudo_proj_True n x"
by (simp add: pseudo_proj_False_stake pseudo_proj_True_def)
thus ?thesis by simp
qed
also have "... = f x" using assms nat_filtration_info by (metis comp_apply)
finally show "(f ∘ pseudo_proj_False n) x = f x" .
qed
lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_characterization:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable M"
shows "f∈ borel_measurable (nat_filtration n) ⟷ f∘ pseudo_proj_True n = f"
using assms nat_filtration_comp_measurable nat_filtration_info by blast
lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_init:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (nat_filtration 0)"
shows "f = (λw. f (sconst True))"
proof
fix w
have "f w = f ((pseudo_proj_True 0) w)" using assms nat_filtration_info[of f 0] by (metis comp_apply)
also have "... = f (sconst True)" by (simp add: pseudo_proj_True_def)
finally show "f w = f (sconst True)" .
qed
lemma (in infinite_coin_toss_space) nat_filtration_Suc_sets:
shows "sets (nat_filtration n) ⊆ sets (nat_filtration (Suc n))"
proof -
{
fix x
assume "x∈ {pseudo_proj_True n -` B ∩ space M |B. B ∈ sets M}"
hence "∃B. B ∈ sets M ∧ x = pseudo_proj_True n -` B ∩ space M" by auto
from this obtain B where "B ∈ sets M" and "x = pseudo_proj_True n -` B ∩ space M"
by blast note xhyps = this
let ?Bim = "B∩ (range (pseudo_proj_True n))"
let ?preT = "(λn w. (pseudo_proj_True n) -` {w})"
have "finite ?Bim" using pseudo_proj_True_finite_image by simp
have "pseudo_proj_True n -`B ∩ (space M) = pseudo_proj_True n -`B"
using bernoulli bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"] by simp
also have "... = pseudo_proj_True n -`?Bim" by auto
also have "... = (⋃ w ∈ ?Bim.?preT n w)" by auto
also have "... = (⋃ w ∈ ?Bim. (?preT (Suc n) w ∪ ?preT (Suc n) (pseudo_proj_False n w)))"
by (simp add:pseudo_proj_True_inverse_induct)
also have "... = (⋃ w ∈ ?Bim. ?preT (Suc n) w) ∪ (⋃ w ∈ ?Bim. ?preT (Suc n) (pseudo_proj_False n w))" by auto
finally have tmpeq: "pseudo_proj_True n -`B ∩ (space M) =
(⋃ w ∈ ?Bim. ?preT (Suc n) w) ∪ (⋃ w ∈ ?Bim. ?preT (Suc n) (pseudo_proj_False n w))" .
have "(⋃ w ∈ ?Bim. ?preT (Suc n) w) ∈ sets (nat_filtration (Suc n))"
using ‹finite ?Bim› nat_filtration_singleton pseudo_proj_True_Suc_proj by auto
moreover have "(⋃ w ∈ ?Bim. ?preT (Suc n) (pseudo_proj_False n w)) ∈ sets (nat_filtration (Suc n))" using ‹finite ?Bim›
by (simp add: nat_filtration_singleton pseudo_proj_True_Suc_False_proj sets.finite_UN)
ultimately have "x ∈ sets (nat_filtration (Suc n))"
using tmpeq xhyps by simp
} note xmem = this
have "sets (nat_filtration n) = sigma_sets (space M) {pseudo_proj_True n -` B ∩ space M |B. B ∈ sets M}"
using bernoulli nat_filtration_sets by blast
also have "... ⊆ (nat_filtration (Suc n))"
proof (rule sigma_algebra.sigma_sets_subset)
show "{pseudo_proj_True n -` B ∩ space M |B. B ∈ sets M}
⊆ sets (nat_filtration (Suc n))" using xmem by auto
show "sigma_algebra (space M) (sets (nat_filtration (Suc n)))"
by (metis bernoulli bernoulli_stream_space nat_filtration_space sets.sigma_algebra_axioms streams_UNIV)
qed
finally show ?thesis .
qed
lemma (in infinite_coin_toss_space) nat_filtration_subalgebra:
shows "subalgebra M (nat_filtration n)" using bernoulli fct_gen_subalgebra_is_subalgebra nat_filtration_def
pseudo_proj_True_measurable by metis
lemma (in infinite_coin_toss_space) nat_discrete_filtration:
shows "filtration M nat_filtration"
unfolding filtration_def
proof((intro conjI), (intro allI)+)
{
fix n
let ?F = "nat_filtration n"
show "subalgebra M ?F"
using bernoulli fct_gen_subalgebra_is_subalgebra nat_filtration_def
pseudo_proj_True_measurable by metis
} note allrm = this
show "∀n m. n ≤ m ⟶ subalgebra (nat_filtration m) (nat_filtration n)"
proof (intro allI impI)
let ?F = nat_filtration
fix n::nat
fix m
show "n ≤ m ⟹ subalgebra (nat_filtration m) (nat_filtration n)"
proof (induct m)
case (Suc m)
have "subalgebra (?F (Suc m)) (?F m)" unfolding subalgebra_def
proof (intro conjI)
show speq: "space (?F m) = space (?F (Suc m))" by (simp add: nat_filtration_space)
show "sets (?F m) ⊆ sets (?F (Suc m))" using nat_filtration_Suc_sets by simp
qed
thus "n ≤ Suc m ⟹ subalgebra (?F (Suc m)) (?F n)" using Suc
using Suc.hyps le_Suc_eq subalgebra_def by fastforce
next
case 0
thus ?case by (simp add: subalgebra_def)
qed
qed
qed
lemma (in infinite_coin_toss_space) nat_info_filtration:
shows "init_triv_filt M nat_filtration" unfolding init_triv_filt_def
proof
show "filtration M nat_filtration" by (simp add:nat_discrete_filtration)
have img: "∀ w∈ space M. pseudo_proj_True 0 w = sconst True" unfolding pseudo_proj_True_def by simp
show "sets (nat_filtration bot) = {{}, space M}"
proof
show "{{}, space M} ⊆ sets (nat_filtration bot)"
by (metis empty_subsetI insert_subset nat_filtration_subalgebra sets.empty_sets sets.top subalgebra_def)
show "sets (nat_filtration bot) ⊆ {{}, space M}"
proof -
have "∀B ∈ sets (bernoulli_stream p). pseudo_proj_True 0 -` B ∩ space M ∈ {{}, space M}"
proof
fix B
assume "B ∈ sets (bernoulli_stream p)"
show "pseudo_proj_True 0 -` B ∩ space M ∈ {{}, space M}"
proof (cases "sconst True ∈ B")
case True
hence "pseudo_proj_True 0 -` B ∩ space M = space M" using img by auto
thus ?thesis by auto
next
case False
hence "pseudo_proj_True 0 -` B ∩ space M = {}" using img by auto
thus ?thesis by auto
qed
qed
hence "{pseudo_proj_True 0 -` B ∩ space M |B. B ∈ sets (bernoulli_stream p)} ⊆ {{}, space M}" by auto
hence "sigma_sets (space (bernoulli_stream p))
{pseudo_proj_True 0 -` B ∩ space M |B. B ∈ sets (bernoulli_stream p)} ⊆ {{}, space M}"
using sigma_algebra.sigma_sets_subset[of "space (bernoulli_stream p)" "{{}, space M}"]
by (simp add: bernoulli sigma_algebra_trivial)
thus ?thesis by (simp add:nat_filtration_sets bot_nat_def)
qed
qed
qed
sublocale infinite_cts_filtration ⊆ triv_init_disc_filtr_prob_space
proof (unfold_locales, intro conjI)
show "disc_filtr M F" unfolding disc_filtr_def
using filtrationE2 nat_discrete_filtration nat_filtration_subalgebra natural_filtration by auto
show "sets (F bot) = {{}, space M}" using nat_info_filtration natural_filtration
unfolding init_triv_filt_def by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_vimage_finite:
fixes f::"bool stream ⇒ 'b::{t2_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "finite (f`(space M))" using pseudo_proj_True_finite_image nat_filtration_info[of f n]
by (metis assms bernoulli bernoulli_stream_space finite_imageI fun.set_map streams_UNIV)
lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_simple:
fixes f::"bool stream ⇒ 'b::{t2_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "simple_function M f"
proof -
have f1: "∀m ma. (m::bool stream measure) →⇩M (ma::'b measure) = {f ∈ space m → space ma. ∀B. B ∈ sets ma ⟶ f -` B ∩ space m ∈ sets m}"
by (metis measurable_def)
then have "f ∈ space (nat_filtration n) → space borel ∧ (∀B. B ∈ sets borel ⟶ f -` B ∩ space (nat_filtration n) ∈ sets (nat_filtration n))"
using assms by blast
then have "f ∈ space M → space borel ∧ (∀B. B ∈ sets borel ⟶ f -` B ∩ space M ∈ events)"
by (metis (no_types) contra_subsetD nat_filtration_subalgebra subalgebra_def)
then have "random_variable borel f"
using f1 by blast
then show ?thesis
using assms nat_filtration_vimage_finite simple_function_borel_measurable by blast
qed
lemma (in infinite_coin_toss_space) nat_filtration_singleton_range_set:
fixes f::"bool stream ⇒ 'b::{t2_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "∃ A∈ sets borel. range f ∩ A = {f x}"
proof -
let ?Ax = "range f - {f x}"
have "range f = f`space M" using bernoulli bernoulli_stream_space by simp
hence "finite ?Ax" using assms nat_filtration_vimage_finite by auto
hence "∃U. open U ∧ f x∈ U ∧ U∩ ?Ax = {}" by (simp add:open_except_set)
then obtain U where "open U" and "f x∈ U" and "U∩ ?Ax = {}" by auto
have "U ∈ sets borel" using ‹open U› by simp
have "range f ∩ U = {f x}" using ‹f x ∈ U› ‹U∩ ?Ax = {}› by blast
thus "∃A∈ sets borel. range f ∩ A = {f x}" using ‹U∈ sets borel› by auto
qed
lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_singleton:
fixes f::"bool stream ⇒ 'b::{t2_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
shows "f -`{f x} ∈ sets (nat_filtration n)"
proof -
let ?Ax = "f`space M - {f x}"
have "finite ?Ax"
using assms nat_filtration_vimage_finite by blast
hence "∃U. open U ∧ f x∈ U ∧ U∩ ?Ax = {}" by (simp add:open_except_set)
then obtain U where "open U" and "f x∈ U" and "U∩ ?Ax = {}" by auto
have "f x ∈ f ` space M" using bernoulli_stream_space bernoulli by simp
hence "f`space M ∩ U = {f x}" using ‹f x∈ U› ‹U∩ ?Ax = {}› by blast
hence "∃A. open A∧ f`space M ∩ A = {f x}" using ‹open U› by auto
from this obtain A where "open A" and inter: "f`space M ∩ A = {f x}" by auto
have "A ∈ sets borel" using ‹open A› by simp
hence "f -`A ∩ space M ∈ sets (nat_filtration n)" using assms nat_filtration_space
by (simp add: bernoulli bernoulli_stream_space in_borel_measurable_borel)
hence "f -`A ∩ space M ∈ events" using nat_filtration_subalgebra
by (meson subalgebra_def subset_eq)
have "f -`{f x}∩ space M = f -`A∩ space M"
proof
have "f x∈ A" using inter by auto
thus "f -` {f x}∩ space M ⊆ f -` A∩ space M" by auto
show "f -` A∩ space M ⊆ f -` {f x}∩ space M"
proof
fix y
assume "y∈ f-` A∩ space M"
hence "f y ∈ A∩ f`space M" by simp
hence "f y = f x" using inter by auto
thus "y∈ f -` {f x}∩ space M" using ‹y∈ f-` A∩ space M› by auto
qed
qed
moreover have "f -`A ∩ space M ∈ (nat_filtration n)" using assms ‹A∈ sets borel›
using ‹f -` A ∩ space M ∈ sets (nat_filtration n)› by blast
ultimately show ?thesis using bernoulli_stream_space bernoulli by simp
qed
lemma (in infinite_cts_filtration) borel_adapt_nat_filtration_info:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
and "m ≤ n"
shows "X m (pseudo_proj_True n w) = X m w"
proof -
have "X m ∈ borel_measurable (F n)" using assms natural_filtration
using increasing_measurable_info
by (metis adapt_stoch_proc_def)
thus ?thesis using nat_filtration_info natural_filtration
by (metis comp_apply)
qed
lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_integrable:
assumes "f∈ borel_measurable (nat_filtration n)"
shows "integrable M f"
proof -
have "simple_function M f" using assms by (simp add: nat_filtration_borel_measurable_simple)
moreover have "emeasure M {y ∈ space M. f y ≠ 0} ≠ ∞" by simp
ultimately have "Bochner_Integration.simple_bochner_integrable M f"
using Bochner_Integration.simple_bochner_integrable.simps by blast
hence "has_bochner_integral M f (Bochner_Integration.simple_bochner_integral M f)"
using has_bochner_integral_simple_bochner_integrable by auto
thus ?thesis using integrable.simps by auto
qed
definition (in infinite_coin_toss_space) spick:: "bool stream ⇒ nat ⇒ bool ⇒ bool stream" where
"spick w n v = shift (stake n w) (v## sconst True)"
lemma (in infinite_coin_toss_space) spickI:
shows "stake n (spick w n v) = stake n w ∧ snth (spick w n v) n = v"
by (simp add: spick_def stake_shift)
lemma (in infinite_coin_toss_space) spick_eq_pseudo_proj_True:
shows "spick w n True = pseudo_proj_True n w" unfolding spick_def pseudo_proj_True_def
by (metis (full_types) id_apply siterate.code)
lemma (in infinite_coin_toss_space) spick_eq_pseudo_proj_False:
shows "spick w n False = pseudo_proj_False n w" unfolding spick_def pseudo_proj_False_def by simp
lemma (in infinite_coin_toss_space) spick_pseudo_proj:
shows "spick (pseudo_proj_True (Suc n) w) n v = spick w n v"
by (metis pseudo_proj_True_proj_Suc pseudo_proj_True_stake spick_def)
lemma (in infinite_coin_toss_space) spick_pseudo_proj_gen:
shows "m < n ⟹ spick (pseudo_proj_True n w) m v = spick w m v"
by (metis Suc_leI pseudo_proj_True_proj pseudo_proj_True_prefix spick_pseudo_proj)
lemma (in infinite_coin_toss_space) spick_nat_filtration_measurable:
shows "(λw. spick w n v) ∈ measurable (nat_filtration n) M"
proof (rule nat_filtration_comp_measurable)
show "(λw. spick w n v) ∈ measurable M M"
proof -
let ?N = "bernoulli_stream p"
have "id ∈ measurable ?N ?N" by simp
moreover have "(λw. v## (sconst True)) ∈ measurable ?N ?N" using bernoulli_stream_space by simp
ultimately show ?thesis using measurable_shift bernoulli p_gt_0 p_lt_1
unfolding bernoulli_stream_def spick_def by simp
qed
{
fix w
have "spick (pseudo_proj_True n w) n v = spick w n v"
by (simp add: pseudo_proj_True_stake spick_def)
}
thus "(λw. spick w n v) ∘ pseudo_proj_True n = (λw. spick w n v)" by auto
qed
definition (in infinite_coin_toss_space) proj_rep_set:
"proj_rep_set n = range (pseudo_proj_True n)"
lemma (in infinite_coin_toss_space) proj_rep_set_finite:
shows "finite (proj_rep_set n)" using pseudo_proj_True_finite_image
by (simp add: proj_rep_set)
lemma (in infinite_coin_toss_space) set_filt_contain:
assumes "A∈ sets (nat_filtration n)"
and "w∈ A"
shows "pseudo_proj_True n -` {pseudo_proj_True n w} ⊆ A"
proof
define indA where "indA = ((indicator A)::bool stream⇒real)"
have "indA ∈ borel_measurable (nat_filtration n)" unfolding indA_def
by (simp add: assms(1) borel_measurable_indicator)
fix x
assume "x ∈ pseudo_proj_True n -` {pseudo_proj_True n w}"
have "indA x = indA (pseudo_proj_True n x)"
using nat_filtration_info[symmetric, of "indicator A" n] ‹indA ∈ borel_measurable (nat_filtration n)›
unfolding indA_def by (metis comp_apply)
also have "... = indA (pseudo_proj_True n w)" using ‹x ∈ pseudo_proj_True n -` {pseudo_proj_True n w}›
by simp
also have "... = indA w" using nat_filtration_info[of "indicator A" n]
‹indA ∈ borel_measurable (nat_filtration n)› unfolding indA_def by (metis comp_apply)
also have "... = 1" using assms unfolding indA_def by simp
finally have "indA x = 1" .
thus "x∈ A" unfolding indA_def by (simp add: indicator_eq_1_iff)
qed
lemma (in infinite_cts_filtration) measurable_range_rep:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f ∈ borel_measurable (nat_filtration n)"
shows "range f = (⋃ r∈(proj_rep_set n). {f(r)})"
proof -
have "f = f ∘ (pseudo_proj_True n)" using assms nat_filtration_info[of f n] by simp
hence "range f = f `(proj_rep_set n)" by (metis fun.set_map proj_rep_set)
also have "... = (⋃r∈proj_rep_set n. {f r})" by blast
finally show "range f = (⋃r∈proj_rep_set n. {f r})" .
qed
lemma (in infinite_coin_toss_space) borel_measurable_stake:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (nat_filtration n)"
and "stake n w = stake n y"
shows "f w = f y"
proof -
have "pseudo_proj_True n w = pseudo_proj_True n y" unfolding pseudo_proj_True_def using assms by simp
thus ?thesis using assms nat_filtration_info by (metis comp_apply)
qed
subsubsection ‹Probability component›
text ‹The probability component permits to compute measures of subspaces in a straightforward way.›
definition prob_component where
"prob_component (p::real) w n = (if (snth w n) then p else 1-p)"
lemma prob_component_neq_zero:
assumes "0 < p"
and "p < 1"
shows "prob_component p w n ≠ 0" using assms prob_component_def by auto
lemma prob_component_measure:
fixes x::"bool stream"
assumes "0 ≤ p"
and "p ≤ 1"
shows "emeasure (measure_pmf (bernoulli_pmf p)) {snth x i} = prob_component p x i" unfolding prob_component_def using emeasure_pmf_single
pmf_bernoulli_False pmf_bernoulli_True
by (simp add: emeasure_pmf_single assms)
lemma stake_preimage_measurable:
fixes x::"bool stream"
assumes "Suc 0 ≤ n" and "M = bernoulli_stream p"
shows "{w∈ space M. (stake n w = stake n x)} ∈ sets M"
proof -
let ?S = "{w∈ space M. (stake n w = stake n x)}"
have "?S = (⋂ i ∈ {0.. n-1}. {w∈ space M. (snth w i = snth x i)})" using stake_inter_snth assms by simp
moreover have "(⋂ i ∈ {0.. n-1}. {w∈ space M. (snth w i = snth x i)}) ∈ sets M"
proof -
have "∀ i ≤ n-1. {w∈ space M. (snth w i = snth x i)} ∈ sets M"
proof (intro allI impI)
fix i
assume "i ≤ n-1"
thus "{w ∈ space M. w !! i = x !! i} ∈ sets M"
proof -
have "(λw. snth w i) ∈ measurable M (measure_pmf (bernoulli_pmf p))" using assms by (simp add: assms bernoulli_stream_def)
thus ?thesis by simp
qed
qed
thus ?thesis by auto
qed
ultimately show ?thesis by simp
qed
lemma snth_as_fct:
fixes b
assumes "M = bernoulli_stream p"
shows "to_stream -` {w∈ space M. snth w i = b} = {X::nat⇒bool. X i = b}"
proof -
let ?S = "{w∈ space M. snth w i = b}"
let ?PM = "(λi::nat. (measure_pmf (bernoulli_pmf p)))"
have isps: "product_prob_space ?PM" by unfold_locales
let ?Z = "{X::nat⇒bool. X i = b}"
show "to_stream -`?S = ?Z" by (simp add: assms bernoulli_stream_space to_stream_def)
qed
lemma stake_as_fct:
assumes "Suc 0 ≤ n" and "M= bernoulli_stream p"
shows "to_stream -`{w∈ space M. (stake n w = stake n x)} = {X::nat⇒bool. ∀i. 0 ≤ i ∧ i ≤ n-1 ⟶ X i = snth x i}"
proof -
let ?S = "{w∈ space M. (stake n w = stake n x)}"
let ?Z = "{X::nat⇒bool. ∀i. 0 ≤ i ∧ i ≤ n-1 ⟶ X i = snth x i}"
have "to_stream -` ?S = to_stream -` (⋂ i ∈ {0.. n-1}. {w∈ space M. (snth w i = snth x i)})"
using ‹Suc 0 ≤ n› stake_inter_snth by blast
also have "... = (⋂ i ∈ {0.. n-1}. to_stream -`{w∈ space M. (snth w i = snth x i)})" by auto
also have "... = (⋂ i ∈ {0.. n-1}. {X::nat⇒bool. X i = snth x i})" using snth_as_fct assms by simp
also have "... = ?Z" by auto
finally show ?thesis .
qed
lemma bernoulli_stream_npref_prob:
fixes x
assumes "M = bernoulli_stream p"
shows "emeasure M {w∈ space M. (stake 0 w = stake 0 x)} = 1"
proof -
define S where "S = {w∈ space M. (stake 0 w = stake 0 x)}"
have "S = space M" unfolding S_def by simp
thus ?thesis
by (simp add: assms bernoulli_stream_def prob_space.emeasure_space_1
prob_space.prob_space_stream_space prob_space_measure_pmf)
qed
lemma bernoulli_stream_pref_prob:
fixes x
assumes "M =bernoulli_stream p"
and "0 ≤ p" and "p ≤ 1"
shows "n≥ Suc 0⟹ emeasure M {w∈ space M. (stake n w = stake n x)} = (∏i∈{0..n-1}. prob_component p x i)"
proof -
have "prob_space M"
by (simp add: assms bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
fix n::nat
assume "n≥ Suc 0"
define S where "S = {w∈ space M. (stake n w = stake n x)}"
have s: "S ∈ sets M" unfolding S_def by (simp add: assms stake_preimage_measurable ‹Suc 0 ≤ n›)
define PM where "PM = (λi::nat. (measure_pmf (bernoulli_pmf p)))"
have isps: "product_prob_space PM" unfolding PM_def by unfold_locales
define Z where "Z = {X::nat⇒bool. ∀i. 0 ≤ i ∧ i ≤ n-1 ⟶ X i = snth x i}"
let ?wPM = "Pi⇩M UNIV PM"
define imgSbs where "imgSbs = prod_emb UNIV PM {0..n-1} (Pi⇩E {0..n-1} (λi::nat. {snth x i}))"
have "space ?wPM = UNIV" using space_PiM unfolding PM_def by fastforce
hence "(to_stream -` S ∩ (space ?wPM)) = to_stream -` S" by simp
also have "... = Z" using stake_as_fct ‹Suc 0 ≤ n› assms unfolding Z_def S_def by simp
also have "... = imgSbs"
proof
{
fix X
assume "X ∈ imgSbs"
hence "restrict X {0..n-1} ∈ (Pi⇩E {0..n-1} (λi::nat. {snth x i}))" using prod_emb_iff[of X] unfolding imgSbs_def by simp
hence "∀i. 0 ≤ i ∧ i ≤ n-1 ⟶ X i = snth x i" by auto
hence "X ∈ Z" unfolding Z_def by simp
}
thus "imgSbs ⊆ Z" by blast
{
fix X
assume "X ∈ Z"
hence "∀i. 0 ≤ i ∧ i ≤ n-1 ⟶ X i = snth x i" unfolding Z_def by simp
hence "restrict X {0..n-1} ∈ (Pi⇩E {0..n-1} (λi::nat. {snth x i}))" by simp
moreover have "X ∈ extensional UNIV" by simp
moreover have "∀i ∈ UNIV. X i ∈ space (PM i)" unfolding PM_def by auto
ultimately have "X ∈ imgSbs"
using prod_emb_iff[of X] unfolding imgSbs_def by simp
}
thus "Z ⊆ imgSbs" by auto
qed
finally have inteq: "(to_stream -` S ∩ (space ?wPM)) = imgSbs" .
have "emeasure M S = emeasure ?wPM (to_stream -` S ∩ (space ?wPM))"
using emeasure_distr[of "to_stream" ?wPM "M" S] measurable_to_stream[of "(measure_pmf (bernoulli_pmf p))"] s assms
unfolding bernoulli_stream_def stream_space_def PM_def
by (simp add: emeasure_distr)
also have "... = emeasure ?wPM imgSbs" using inteq by simp
also have "... = (∏i∈{0..n-1}. emeasure (PM i) ((λm::nat. {snth x m}) i))"
using isps unfolding imgSbs_def PM_def by (auto simp add:product_prob_space.emeasure_PiM_emb)
also have "... = (∏i∈{0..n-1}. prob_component p x i)" using prob_component_measure unfolding PM_def
proof -
have f1: "∀N f. (∃n. (n::nat) ∈ N ∧ ¬ 0 ≤ f n) ∨ (∏n∈N. ennreal (f n)) = ennreal (prod f N)"
by (metis (no_types) prod_ennreal)
obtain nn :: "(nat ⇒ real) ⇒ nat set ⇒ nat" where
f2: "∀x0 x1. (∃v2. v2 ∈ x1 ∧ ¬ 0 ≤ x0 v2) = (nn x0 x1 ∈ x1 ∧ ¬ 0 ≤ x0 (nn x0 x1))"
by moura
have f3: "∀s n. if s !! n then prob_component p s n = p else p + prob_component p s n = 1"
by (simp add: prob_component_def)
{ assume "prob_component p x (nn (prob_component p x) {0..n - 1}) ≠ p"
then have "p + prob_component p x (nn (prob_component p x) {0..n - 1}) = 1"
using f3 by metis
then have "nn (prob_component p x) {0..n - 1} ∉ {0..n - 1} ∨ 0 ≤ prob_component p x (nn (prob_component p x) {0..n - 1})"
using assms by linarith }
then have "nn (prob_component p x) {0..n - 1} ∉ {0..n - 1} ∨ 0 ≤ prob_component p x (nn (prob_component p x) {0..n - 1})"
using assms by linarith
then have "(∏n = 0..n - 1. ennreal (prob_component p x n)) = ennreal (prod (prob_component p x) {0..n - 1})"
using f2 f1 by meson
moreover have "(∏n = 0..n - 1. ennreal (prob_component p x n)) =
(∏n = 0..n - 1. emeasure (measure_pmf (bernoulli_pmf p)) {x !! n})" using prob_component_measure[of p x]
assms by simp
ultimately show "(∏n = 0..n - 1. emeasure (measure_pmf (bernoulli_pmf p)) {x !! n}) = ennreal (prod (prob_component p x) {0..n - 1})"
using prob_component_measure[of p x] by simp
qed
finally show "emeasure M S = (∏i∈{0..n-1}. prob_component p x i)" .
qed
lemma bernoulli_stream_pref_prob':
fixes x
assumes "M = bernoulli_stream p"
and "p ≤ 1" and "0 ≤ p"
shows "emeasure M {w∈ space M. (stake n w = stake n x)} = (∏i∈{0..<n}. prob_component p x i)"
proof (cases "Suc 0 ≤ n")
case True
hence "emeasure M {w∈ space M. (stake n w = stake n x)} = (∏i∈{0..n -1}. prob_component p x i)" using assms
by (simp add: bernoulli_stream_pref_prob)
moreover have "(∏i∈{0..n -1}. prob_component p x i) = (∏i∈{0..<n}. prob_component p x i)"
proof (rule prod.cong)
show "{0..n - 1} = {0..<n}" using True by auto
show "⋀xa. xa ∈ {0..<n} ⟹ prob_component p x xa = prob_component p x xa" by simp
qed
ultimately show ?thesis by simp
next
case False
hence "n = 0" using False by simp
have "{w∈ space M. (stake n w = stake n x)} = space M"
proof
show "{w ∈ space M. stake n w = stake n x} ⊆ space M"
proof
fix w
assume "w∈ {w ∈ space M. stake n w = stake n x}"
thus "w ∈ space M" by auto
qed
show "space M ⊆ {w ∈ space M. stake n w = stake n x}"
proof
fix w
assume "w∈ space M"
have "stake 0 w = stake 0 x" by simp
hence "stake n w = stake n x" using ‹n = 0› by simp
thus "w∈ {w ∈ space M. stake n w = stake n x}" using ‹w∈ space M› by auto
qed
qed
hence "emeasure M {w ∈ space M. stake n w = stake n x} = emeasure M (space M)" by simp
also have "... = 1" using assms
by (simp add: bernoulli_stream_def prob_space.emeasure_space_1
prob_space.prob_space_stream_space prob_space_measure_pmf)
also have "... = (∏i∈{0..<n}. prob_component p x i)" using ‹n = 0› by simp
finally show ?thesis .
qed
lemma bernoulli_stream_stake_prob:
fixes x
assumes "M = bernoulli_stream p"
and "p ≤ 1" and "0 ≤ p"
shows "measure M {w∈ space M. (stake n w = stake n x)} = (∏i∈{0..<n}. prob_component p x i)"
proof -
have "measure M {w∈ space M. (stake n w = stake n x)} = emeasure M {w∈ space M. (stake n w = stake n x)}"
by (metis (no_types, lifting) assms(1) bernoulli_stream_def emeasure_eq_ennreal_measure emeasure_space
ennreal_one_neq_top neq_top_trans prob_space.emeasure_space_1 prob_space.prob_space_stream_space
prob_space_measure_pmf)
also have "... = (∏i∈{0..<n}. prob_component p x i)" using bernoulli_stream_pref_prob' assms by simp
finally show ?thesis by (simp add: assms(2) assms(3) prob_component_def prod_nonneg)
qed
lemma (in infinite_coin_toss_space) bernoulli_stream_pseudo_prob:
fixes x
assumes "M = bernoulli_stream p"
and "p ≤ 1" and "0 ≤ p"
and "w∈ range (pseudo_proj_True n)"
shows "measure M (pseudo_proj_True n -`{w} ∩ space M) = (∏i∈{0..<n}. prob_component p w i)"
proof -
have "(pseudo_proj_True n -`{w}) ∩ space M = {x∈ space M. (stake n w = stake n x)}"
using assms(4) infinite_coin_toss_space.pseudo_proj_True_def infinite_coin_toss_space_axioms
pseudo_proj_True_preimage_stake pseudo_proj_True_stake by force
thus ?thesis using bernoulli_stream_stake_prob assms
proof -
have "pseudo_proj_True n w = w"
using ‹w ∈ range (pseudo_proj_True n)› pseudo_proj_True_proj by blast
then show ?thesis
using bernoulli bernoulli_stream_stake_prob p_gt_0 p_lt_1 pseudo_proj_True_preimage_stake_space by presburger
qed
qed
lemma bernoulli_stream_element_prob_rec:
fixes x
assumes "M = bernoulli_stream p"
and "0 ≤ p" and "p ≤ 1"
shows "⋀ n. emeasure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)} =
(emeasure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)"
proof -
fix n
define S where "S = {w∈ space M. (stake (Suc n) w = stake (Suc n) x)}"
define precS where "precS = {w∈ space M. (stake n w = stake n x)}"
show "emeasure M S = emeasure M precS * prob_component p x n"
proof (cases " n≤ 0")
case True
hence "n=0" by simp
hence "emeasure M S = (∏i∈{0..n}. prob_component p x i)" unfolding S_def
using bernoulli_stream_pref_prob assms diff_Suc_1 le_refl by presburger
also have "... = prob_component p x 0" using True by simp
also have "... = emeasure M precS * prob_component p x n" using bernoulli_stream_npref_prob assms
by (simp add: ‹n=0› precS_def)
finally show "emeasure M S = emeasure M precS * prob_component p x n" .
next
case False
hence "n ≥ Suc 0" by simp
hence "emeasure M S = (∏i∈{0..n}. prob_component p x i)" unfolding S_def
using bernoulli_stream_pref_prob diff_Suc_1 le_refl assms by fastforce
also have "... = (∏i∈{0..n-1}. prob_component p x i) * prob_component p x n" using ‹n ≥ Suc 0›
by (metis One_nat_def Suc_le_lessD Suc_pred prod.atLeast0_atMost_Suc)
also have "... = emeasure M precS * prob_component p x n" using bernoulli_stream_pref_prob
unfolding precS_def
using ‹Suc 0 ≤ n› ennreal_mult'' assms prob_component_def by auto
finally show "emeasure M S = emeasure M precS * prob_component p x n" .
qed
qed
lemma bernoulli_stream_element_prob_rec':
fixes x
assumes "M = bernoulli_stream p"
and "0 ≤ p" and "p ≤ 1"
shows "⋀ n. measure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)} =
(measure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)"
proof -
fix n
have "ennreal (measure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)}) =
emeasure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)}"
by (metis (no_types, lifting) assms(1) bernoulli_stream_def emeasure_eq_ennreal_measure
emeasure_space ennreal_top_neq_one neq_top_trans prob_space.emeasure_space_1
prob_space.prob_space_stream_space prob_space_measure_pmf)
also have "... = (emeasure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)"
using bernoulli_stream_element_prob_rec assms by simp
also have "... = (measure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)"
proof -
have "prob_space M"
using assms(1) bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf by auto
then show ?thesis
by (simp add: ennreal_mult'' finite_measure.emeasure_eq_measure mult.commute prob_space_def)
qed
finally have "ennreal (measure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)}) =
(measure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)" .
thus "measure M {w∈ space M. (stake (Suc n) w = stake (Suc n) x)} =
(measure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)"
using assms prob_component_def by auto
qed
lemma (in infinite_coin_toss_space) bernoulli_stream_pseudo_prob_rec':
fixes x
assumes "pseudo_proj_True n x = x"
shows "measure M (pseudo_proj_True (Suc n) -`{x}) =
(measure M (pseudo_proj_True n-`{x}) * prob_component p x n)"
proof -
have "pseudo_proj_True (Suc n) -`{x} = {w. (stake (Suc n) w = stake (Suc n) x)}" using pseudo_proj_True_preimage_stake
assms by (metis pseudo_proj_True_Suc_proj)
moreover have "pseudo_proj_True n -`{x} = {w. (stake n w = stake n x)}" using pseudo_proj_True_preimage_stake
assms by simp
ultimately show ?thesis using assms bernoulli_stream_element_prob_rec'
by (simp add: bernoulli bernoulli_stream_space p_gt_0 p_lt_1)
qed
lemma (in infinite_coin_toss_space) bernoulli_stream_pref_prob_pos:
fixes x
assumes "0 < p"
and "p < 1"
shows "emeasure M {w∈ space M. (stake n w = stake n x)} > 0"
proof (induct n)
case 0
hence "emeasure M {w∈ space M. (stake 0 w = stake 0 x)} = 1" using bernoulli_stream_npref_prob[of M p x]
bernoulli by simp
thus ?case by simp
next
case (Suc n)
have "emeasure M {w ∈ space M. stake (Suc n) w = stake (Suc n) x} =
(emeasure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)" using bernoulli_stream_element_prob_rec
bernoulli p_gt_0 p_lt_1 by simp
thus ?case using Suc using assms p_gt_0 p_lt_1 prob_component_def
by (simp add: ennreal_zero_less_mult_iff)
qed
lemma (in infinite_coin_toss_space) bernoulli_stream_pref_prob_neq_zero:
fixes x
assumes "0 < p"
and "p < 1"
shows "emeasure M {w∈ space M. (stake n w = stake n x)} ≠ 0"
proof (induct n)
case 0
hence "emeasure M {w∈ space M. (stake 0 w = stake 0 x)} = 1" using bernoulli_stream_npref_prob[of M p x]
bernoulli by simp
thus ?case by simp
next
case (Suc n)
have "emeasure M {w ∈ space M. stake (Suc n) w = stake (Suc n) x} =
(emeasure M {w∈ space M. (stake n w = stake n x)} * prob_component p x n)" using bernoulli_stream_element_prob_rec
bernoulli assms by simp
thus ?case using Suc using assms p_gt_0 p_lt_1 prob_component_def by auto
qed
lemma (in infinite_coin_toss_space) pseudo_proj_element_prob_pref:
assumes "w∈ range (pseudo_proj_True n)"
shows "emeasure M {y∈ space M. ∃x ∈ (pseudo_proj_True n -`{w}). y = c ## x} =
prob_component p (c##w) 0 * emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)"
proof -
have "pseudo_proj_True n w = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
have "pseudo_proj_True (Suc n) (c##w) = c##w" using assms
pseudo_proj_True_def pseudo_proj_True_stake by auto
have "{y∈ space M. ∃x ∈ (pseudo_proj_True n -`{w}). y = c ## x} = pseudo_proj_True (Suc n) -`{c##w} ∩ space M"
proof
show "{y∈ space M. ∃x∈pseudo_proj_True n -` {w}. y = c ## x} ⊆ pseudo_proj_True (Suc n) -` {c ## w} ∩ space M"
proof
fix y
assume "y∈ {y∈ space M. ∃x∈pseudo_proj_True n -` {w}. y = c ## x}"
hence "y∈ space M" and "∃x ∈ pseudo_proj_True n -` {w}. y = c ## x" by auto
from this obtain x where "x∈ pseudo_proj_True n -` {w}" and "y = c## x" by auto
have "pseudo_proj_True (Suc n) y = c##w" using ‹x∈ pseudo_proj_True n -` {w}› ‹y = c## x›
unfolding pseudo_proj_True_def by simp
thus "y ∈ pseudo_proj_True (Suc n) -` {c ## w} ∩ space M" using ‹y∈ space M› by auto
qed
show "pseudo_proj_True (Suc n) -` {c ## w} ∩ space M ⊆ {y∈ space M. ∃x∈pseudo_proj_True n -` {w}. y = c ## x}"
proof
fix y
assume "y ∈ pseudo_proj_True (Suc n) -` {c ## w} ∩ space M"
hence "pseudo_proj_True (Suc n) y = c##w" and "y∈ space M" by auto
have "pseudo_proj_True n (stl y) = pseudo_proj_True n w"
proof (rule pseudo_proj_True_snth')
have "pseudo_proj_True (Suc n) (c##w) = c##w" using ‹pseudo_proj_True (Suc n) (c##w) = c##w› .
also have "... = pseudo_proj_True (Suc n) y" using ‹pseudo_proj_True (Suc n) y = c##w› by simp
finally have "pseudo_proj_True (Suc n) (c##w) = pseudo_proj_True (Suc n) y" .
hence "⋀i. Suc i ≤ Suc n ⟹ (c##w)!! i = y!! i" by (simp add: pseudo_proj_True_snth)
thus "⋀i. Suc i ≤ n ⟹ stl y !! i = w !! i" by fastforce
qed
also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
finally have "pseudo_proj_True n (stl y) = w" .
hence "stl y ∈ (pseudo_proj_True n) -` {w}" by simp
moreover have "y = c##(stl y)"
proof -
have "stake (Suc n) y = stake (Suc n) (pseudo_proj_True (Suc n) y)" unfolding pseudo_proj_True_def
using pseudo_proj_True_def pseudo_proj_True_stake by auto
hence "shd y = shd (pseudo_proj_True (Suc n) y)" by simp
also have "... = shd (c##w)" using ‹pseudo_proj_True (Suc n) y = c##w› by simp
also have "... = c" by simp
finally have "shd y = c" .
thus ?thesis by (simp add: stream_eq_Stream_iff)
qed
ultimately show "y∈ {y∈ space M. ∃x∈pseudo_proj_True n -` {w}. y = c ## x}" using ‹y∈ space M› by auto
qed
qed
hence "emeasure M {y∈ space M. ∃x ∈ (pseudo_proj_True n -`{w}). y = c ## x} =
emeasure M (pseudo_proj_True (Suc n) -`{c##w}∩ space M)" by simp
also have "... = emeasure M {y∈ space M. stake (Suc n) y = stake (Suc n) (c##w)}"
using ‹pseudo_proj_True (Suc n) (c##w) = c##w› by (simp add:pseudo_proj_True_preimage_stake_space)
also have "... = (∏i∈{0..n}. prob_component p (c##w) i)"
using bernoulli_stream_pref_prob[of M p "Suc n" "c##w"] bernoulli p_lt_1 p_gt_0 diff_Suc_1 le_refl by simp
also have "... = prob_component p (c##w) 0 * (∏i∈{1..n}. prob_component p (c##w) i)"
by (simp add: decompose_init_prod)
also have "... = prob_component p (c##w) 0 * (∏i∈{1..< Suc n}. prob_component p (c##w) i)"
proof -
have "(∏i∈{1..n}. prob_component p (c##w) i) = (∏i∈{1..< Suc n}. prob_component p (c##w) i)"
proof (rule prod.cong)
show "{1..n} = {1..<Suc n}" by auto
show "⋀x. x ∈ {1..<Suc n} ⟹ prob_component p (c ## w) x = prob_component p (c ## w) x" by simp
qed
thus ?thesis by simp
qed
also have "... = prob_component p (c##w) 0 * (∏i∈{0..< n}. prob_component p w i)"
proof -
have "(∏i∈{1..< Suc n}. prob_component p (c##w) i) = (∏i∈{0..< n}. prob_component p w i)"
proof (rule prod.reindex_cong)
show "inj_on (λn. Suc n) {0..<n}" by simp
show "{1..< Suc n} = Suc ` {0..< n}" by auto
show "⋀x. x ∈ {0..< n} ⟹ prob_component p (c ## w) (Suc x) = prob_component p w x"
by (simp add: prob_component_def)
qed
thus ?thesis by simp
qed
also have "... = prob_component p (c##w) 0 * emeasure M {y ∈ space M. stake n y = stake n w}"
using bernoulli_stream_pref_prob'[symmetric, of M p w n] ennreal_mult' p_gt_0 p_lt_1 bernoulli
prob_component_def by auto
also have "... = prob_component p (c##w) 0 * emeasure M (pseudo_proj_True n -` {w} ∩ space M)"
using pseudo_proj_True_preimage_stake_space ‹pseudo_proj_True n w = w›
by (simp add: pseudo_proj_True_preimage_stake_space)
finally show ?thesis .
qed
subsubsection ‹Filtration equivalence for the natural filtration›
lemma (in infinite_coin_toss_space) nat_filtration_null_set:
assumes "A∈ sets (nat_filtration n)"
and "0 < p"
and "p < 1"
and "emeasure M A = 0"
shows "A = {}"
proof (rule ccontr)
assume "A≠ {}"
hence "∃w. w∈ A" by auto
from this obtain w where "w ∈ A" by auto
hence inc: "pseudo_proj_True n -` {pseudo_proj_True n w} ⊆ A" using assms by (simp add: set_filt_contain)
have "0 < emeasure M {x∈ space M. (stake n x = stake n (pseudo_proj_True n w))}" using assms by (simp add: bernoulli_stream_pref_prob_pos)
also have "... = emeasure M (pseudo_proj_True n -` {pseudo_proj_True n w})" using pseudo_proj_True_preimage_stake
pseudo_proj_True_proj bernoulli bernoulli_stream_space by simp
also have "... ≤ emeasure M A"
proof (rule emeasure_mono, (simp add: inc))
show "A ∈ events" using assms nat_discrete_filtration unfolding filtration_def subalgebra_def by auto
qed
finally have "0 < emeasure M A" .
thus False using assms by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_AE_zero:
fixes f::"bool stream ⇒ real"
assumes "AE w in M. f w = 0"
and "f∈ borel_measurable (nat_filtration n)"
and "0 < p"
and "p < 1"
shows "∀w. f w = 0"
proof -
from ‹AE w in M. f w = 0› obtain N' where Nprops: "{w∈ space M. ¬f w = 0} ⊆ N'" "N'∈ sets M" "emeasure M N' = 0"
by (force elim:AE_E)
have "{w∈ space M. f w < 0} ∈ sets (nat_filtration n)"
by (metis (no_types) assms(2) bernoulli bernoulli_stream_space borel_measurable_iff_less nat_filtration_space streams_UNIV)
moreover have "{w∈ space M. f w > 0} ∈ sets (nat_filtration n)"
by (metis (no_types) assms(2) bernoulli bernoulli_stream_space borel_measurable_iff_greater nat_filtration_space streams_UNIV)
moreover have "{w∈ space M. ¬f w = 0} = {w∈ space M. f w < 0} ∪ {w∈ space M. f w > 0}" by auto
ultimately have "{w∈ space M. ¬f w = 0} ∈ sets (nat_filtration n)" by auto
hence "emeasure M {w∈ space M. ¬f w = 0} = 0" using Nprops by (metis (no_types, lifting) emeasure_eq_0)
hence "{w∈ space M. ¬f w = 0} = {}" using ‹{w∈ space M. ¬f w = 0} ∈ sets (nat_filtration n)›
nat_filtration_null_set[of "{w ∈ space M. f w ≠ 0}" n] assms by simp
hence "{w. f w≠ 0} = {}" by (simp add:bernoulli_stream_space bernoulli)
thus ?thesis by auto
qed
lemma (in infinite_coin_toss_space) nat_filtration_AE_eq:
fixes f::"bool stream ⇒ real"
assumes "AE w in M. f w = g w"
and "0 < p"
and "p < 1"
and "f∈ borel_measurable (nat_filtration n)"
and "g∈ borel_measurable (nat_filtration n)"
shows "f w = g w"
proof -
define diff where "diff = (λw. f w - g w)"
have "AE w in M. diff w = 0"
proof (rule AE_mp)
show "AE w in M. f w = g w" using assms by simp
show "AE w in M. f w = g w ⟶ diff w = 0"
by (rule AE_I2, intro impI, (simp add: diff_def))
qed
have "∀w. diff w = 0"
proof (rule nat_filtration_AE_zero)
show "AE w in M. diff w = 0" using ‹AE w in M. diff w = 0› .
show "diff ∈ borel_measurable (nat_filtration n)" using assms unfolding diff_def by simp
show "0 < p" and "p < 1" using assms by auto
qed
thus "f w = g w" unfolding diff_def by auto
qed
lemma (in infinite_coin_toss_space) bernoulli_stream_equiv:
assumes "N = bernoulli_stream q"
and "0 < p"
and "p < 1"
and "0 < q"
and "q < 1"
shows "filt_equiv nat_filtration M N" unfolding filt_equiv_def
proof (intro conjI)
have "sets (stream_space (measure_pmf (bernoulli_pmf p))) = sets (stream_space (measure_pmf (bernoulli_pmf q)))"
by (rule sets_stream_space_cong, simp)
thus "events = sets N" using assms bernoulli unfolding bernoulli_stream_def by simp
show "filtration M nat_filtration" by (simp add:nat_discrete_filtration)
show "∀t A. A ∈ sets (nat_filtration t) ⟶ (emeasure M A = 0) = (emeasure N A = 0)"
proof (intro allI impI)
fix n
fix A
assume "A∈ sets (nat_filtration n)"
show "(emeasure M A = 0) = (emeasure N A = 0)"
proof
{
assume "emeasure M A = 0"
hence "A = {}" using ‹A∈ sets (nat_filtration n)› using assms by (simp add:nat_filtration_null_set)
thus "emeasure N A = 0" by simp
}
{
assume "emeasure N A = 0"
hence "A = {}" using ‹A∈ sets (nat_filtration n)› infinite_coin_toss_space.nat_filtration_null_set[of q N A n]
assms
using ‹events = sets N› bernoulli bernoulli_stream_space infinite_coin_toss_space.nat_filtration_sets
infinite_coin_toss_space_def nat_filtration_sets by force
thus "emeasure M A = 0" by simp
}
qed
qed
qed
lemma (in infinite_coin_toss_space) bernoulli_nat_filtration:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "0 < p"
and "p < 1"
shows "infinite_cts_filtration q N nat_filtration"
proof (unfold_locales)
have "0 < q" using assms by simp
thus "0 ≤ q" by simp
have "q < 1" using assms by simp
thus "q ≤ 1" by simp
show "N = bernoulli_stream q" using assms by simp
show "nat_filtration = infinite_coin_toss_space.nat_filtration N"
proof -
have "filt_equiv nat_filtration M N" using ‹q < 1› ‹0 < q›
by (simp add: assms bernoulli_stream_equiv)
hence "sets M = sets N" unfolding filt_equiv_def by simp
hence "space M = space N" using sets_eq_imp_space_eq by auto
have "∀m. nat_filtration m = infinite_coin_toss_space.nat_filtration N m"
proof
fix m
have "infinite_coin_toss_space.nat_filtration N m = fct_gen_subalgebra N N (pseudo_proj_True m)"
using ‹0 ≤ q› ‹N = bernoulli_stream q› ‹q ≤ 1› infinite_coin_toss_space.intro
infinite_coin_toss_space.nat_filtration_def by blast
thus "nat_filtration m = infinite_coin_toss_space.nat_filtration N m"
unfolding nat_filtration_def
using fct_gen_subalgebra_cong[of M N M N "pseudo_proj_True m"] ‹sets M = sets N› ‹space M = space N›
by simp
qed
thus ?thesis by auto
qed
qed
subsubsection ‹More results on the projection function›
lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_prefix:
shows "pseudo_proj_True (Suc n) w = (w!!0)## pseudo_proj_True n (stl w)"
proof -
have "pseudo_proj_True (Suc n) w = shift (stake (Suc n) w) (sconst True)" unfolding pseudo_proj_True_def by simp
also have "... = shift (w!!0 # (stake n (stl w))) (sconst True)" by simp
also have "... = w!!0 ## shift (stake n (stl w)) (sconst True)" by simp
also have "... = w!!0 ## pseudo_proj_True n (stl w)" unfolding pseudo_proj_True_def by simp
finally show ?thesis .
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_img:
assumes "pseudo_proj_True n w = w"
shows "w∈ range (pseudo_proj_True n)"
by (metis assms rangeI)
lemma (in infinite_coin_toss_space) sconst_if:
assumes "⋀n. snth w n = True"
shows "w = sconst True"
proof -
obtain nn :: "(bool ⇒ bool) ⇒ bool stream ⇒ bool stream ⇒ nat" where
"⋀p s n sa sb na pa sc pb sd se. (¬ p (s !! n::bool) ∨ smap p s ≠ sa ∨ sa !! n) ∧ (¬ sb !! na ∨ smap pa sc ≠ sb ∨ pa (sc !! na::bool)) ∧ (¬ pb (sd !! nn pb sd se) ∨ ¬ se !! nn pb sd se ∨ smap pb sd = se)"
using smap_alt by moura
then show ?thesis
by (metis (no_types) assms eq_id_iff id_funpow snth_siterate)
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_suc_img_pref:
shows "range (pseudo_proj_True (Suc n)) = {y. ∃w ∈ range (pseudo_proj_True n). y = True ## w} ∪
{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}"
proof
show "range (pseudo_proj_True (Suc n))
⊆ {y. ∃w ∈ range (pseudo_proj_True n). y = True ## w} ∪ {y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}"
proof
fix x
assume "x ∈ range (pseudo_proj_True (Suc n))"
hence "x = pseudo_proj_True (Suc n) x" using pseudo_proj_True_proj by auto
define xp where "xp = stl x"
have "xp = stl (shift (stake (Suc n) x) (sconst True))" using ‹x = pseudo_proj_True (Suc n) x›
unfolding xp_def pseudo_proj_True_def by simp
also have "... = shift ((stake n (stl x))) (sconst True)" by simp
finally have "xp = shift ((stake n (stl x))) (sconst True)" .
hence "xp ∈ range (pseudo_proj_True n)" using pseudo_proj_True_def by auto
show "x∈ {y. ∃w ∈ range (pseudo_proj_True n) . y = True ## w} ∪ {y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}"
proof (cases "snth x 0")
case True
have "x = True ## xp" unfolding xp_def using True by (simp add: stream_eq_Stream_iff)
hence "x ∈ {y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}" using ‹xp ∈ range (pseudo_proj_True n)› by auto
thus ?thesis by auto
next
case False
have "x = False ## xp" unfolding xp_def using False by (simp add: stream_eq_Stream_iff)
hence "x ∈ {y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}" using ‹xp ∈ range (pseudo_proj_True n)› by auto
thus ?thesis by auto
qed
qed
have "{y. ∃w ∈ range (pseudo_proj_True n) . y = True ## w} ⊆ range (pseudo_proj_True (Suc n))"
proof
fix y
assume "y ∈ {y. ∃w ∈ range (pseudo_proj_True n) . y = True ## w}"
hence "∃w. w ∈ range (pseudo_proj_True n) ∧ y = True ## w" by auto
from this obtain w where "w∈ range (pseudo_proj_True n)" and "y = True ## w" by auto
have "w = pseudo_proj_True n w" using pseudo_proj_True_proj ‹w∈ range (pseudo_proj_True n)› by auto
hence "y = True ## (shift (stake n w) (sconst True))" using ‹y = True ## w› unfolding pseudo_proj_True_def by simp
also have "... = shift (stake (Suc n) (True ## w)) (sconst True)" by simp
also have "... = pseudo_proj_True (Suc n) (True ## w)" unfolding pseudo_proj_True_def by simp
finally have "y = pseudo_proj_True (Suc n) (True##w)" .
thus "y ∈ range (pseudo_proj_True (Suc n))" by simp
qed
moreover have "{y. ∃w ∈ range (pseudo_proj_True n) . y = False ## w} ⊆ range (pseudo_proj_True (Suc n))"
proof
fix y
assume "y ∈ {y. ∃w ∈ range (pseudo_proj_True n) . y = False ## w}"
hence "∃w. w ∈ range (pseudo_proj_True n) ∧ y = False ## w" by auto
from this obtain w where "w∈ range (pseudo_proj_True n)" and "y = False ## w" by auto
have "w = pseudo_proj_True n w" using pseudo_proj_True_proj ‹w∈ range (pseudo_proj_True n)› by auto
hence "y = False ## (shift (stake n w) (sconst True))" using ‹y = False ## w› unfolding pseudo_proj_True_def by simp
also have "... = shift (stake (Suc n) (False ## w)) (sconst True)" by simp
also have "... = pseudo_proj_True (Suc n) (False ## w)" unfolding pseudo_proj_True_def by simp
finally have "y = pseudo_proj_True (Suc n) (False##w)" .
thus "y ∈ range (pseudo_proj_True (Suc n))" by simp
qed
ultimately show "{y. ∃w ∈ range (pseudo_proj_True n) . y = True ## w} ∪
{y. ∃w ∈ range (pseudo_proj_True n) . y = False ## w} ⊆ range (pseudo_proj_True (Suc n))" by simp
qed
lemma (in infinite_coin_toss_space) reindex_pseudo_proj:
shows "(∑w∈range (pseudo_proj_True n). f (c ## w)) =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = c ## w}.f y)"
proof (rule sum.reindex_cong[symmetric],auto)
define ccons where "ccons = (λw. c## w)"
show "inj_on ccons (range (pseudo_proj_True n))"
proof
fix x y
assume "x∈ range (pseudo_proj_True n)" and "y∈ range (pseudo_proj_True n)" and "ccons x = ccons y"
hence "c##x = c##y" unfolding ccons_def by simp
thus "x = y" by simp
qed
qed
lemma (in infinite_coin_toss_space) pseudo_proj_True_imp_False:
assumes "pseudo_proj_True n w = pseudo_proj_True n x"
shows "pseudo_proj_False n w = pseudo_proj_False n x"
by (metis assms pseudo_proj_False_def pseudo_proj_True_stake)
lemma (in infinite_coin_toss_space) pseudo_proj_Suc_prefix:
assumes "pseudo_proj_True n w = pseudo_proj_True n x"
shows "pseudo_proj_True (Suc n) w ∈ {pseudo_proj_True n x, pseudo_proj_False n x}"
proof -
have "pseudo_proj_False n w = pseudo_proj_False n x" using assms pseudo_proj_True_imp_False[of n w x] by simp
hence "{pseudo_proj_True n w, pseudo_proj_False n w} = {pseudo_proj_True n x, pseudo_proj_False n x}" using assms by simp
thus ?thesis using pseudo_proj_True_suc_img[of n w] by simp
qed
lemma (in infinite_coin_toss_space) pseudo_proj_Suc_preimage:
shows "range (pseudo_proj_True (Suc n)) ∩ (pseudo_proj_True n) -` {pseudo_proj_True n x} =
{pseudo_proj_True n x, pseudo_proj_False n x}"
proof
show "range (pseudo_proj_True (Suc n)) ∩ pseudo_proj_True n -` {pseudo_proj_True n x}
⊆ {pseudo_proj_True n x, pseudo_proj_False n x}"
proof
fix w
assume "w∈ range (pseudo_proj_True (Suc n)) ∩ pseudo_proj_True n -` {pseudo_proj_True n x}"
hence "w∈ range (pseudo_proj_True (Suc n))" and "w∈ pseudo_proj_True n -` {pseudo_proj_True n x}" by auto
hence "pseudo_proj_True n w = pseudo_proj_True n x" by simp
have "w = pseudo_proj_True (Suc n) w" using ‹w∈ range (pseudo_proj_True (Suc n))›
using pseudo_proj_True_proj by auto
also have "... ∈ {pseudo_proj_True n x, pseudo_proj_False n x}" using ‹pseudo_proj_True n w = pseudo_proj_True n x›
pseudo_proj_Suc_prefix by simp
finally show "w ∈ {pseudo_proj_True n x, pseudo_proj_False n x}" .
qed
show "{pseudo_proj_True n x, pseudo_proj_False n x}
⊆ range (pseudo_proj_True (Suc n)) ∩ pseudo_proj_True n -` {pseudo_proj_True n x}"
proof -
have "pseudo_proj_True n x ∈ range (pseudo_proj_True (Suc n)) ∩ pseudo_proj_True n -` {pseudo_proj_True n x}"
by (simp add: pseudo_proj_True_Suc_proj pseudo_proj_True_img pseudo_proj_True_proj)
moreover have "pseudo_proj_False n x ∈ range (pseudo_proj_True (Suc n)) ∩ pseudo_proj_True n -` {pseudo_proj_True n x}"
by (metis (no_types, lifting) Int_iff UnI2 infinite_coin_toss_space.pseudo_proj_False_def infinite_coin_toss_space_axioms
pseudo_proj_True_Suc_False_proj pseudo_proj_True_inverse_induct pseudo_proj_True_stake rangeI singletonI vimage_eq)
ultimately show ?thesis by auto
qed
qed
lemma (in infinite_cts_filtration) f_borel_Suc_preimage:
assumes "f∈ measurable (F n) N"
and "set_discriminating n f N"
shows "range (pseudo_proj_True (Suc n)) ∩ f -` {f x} =
(pseudo_proj_True n) ` (f -` {f x}) ∪ (pseudo_proj_False n) ` (f -` {f x})"
proof -
have "range (pseudo_proj_True (Suc n)) ∩ f -` {f x} =
(⋃ w∈ {y. f y = f x}.{pseudo_proj_True n w, pseudo_proj_False n w})"
proof
show "range (pseudo_proj_True (Suc n)) ∩ f -` {f x} ⊆ (⋃w∈{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})"
proof
fix w
assume "w∈ range (pseudo_proj_True (Suc n)) ∩ f -` {f x}"
hence "w∈ range (pseudo_proj_True (Suc n))" and "w∈ f -` {f x}" by auto
hence "f w = f x" by simp
hence "w∈ {y. f y = f x}" by simp
have "w = pseudo_proj_True (Suc n) w" using ‹w∈ range (pseudo_proj_True (Suc n))›
using pseudo_proj_True_proj by auto
also have "... ∈ {pseudo_proj_True n w, pseudo_proj_False n w}"
using pseudo_proj_Suc_prefix by auto
also have "... ⊆ (⋃w∈{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})" using ‹w∈ {y. f y = f x}›
by auto
finally show "w ∈ (⋃w∈{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})" .
qed
show "(⋃w∈{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})
⊆ range (pseudo_proj_True (Suc n)) ∩ f -` {f x}"
proof
fix w
assume "w ∈ (⋃w∈{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})"
hence "∃y. f y = f x ∧ w∈ {pseudo_proj_True n y, pseudo_proj_False n y}" by auto
from this obtain y where "f y = f x" and "w∈ {pseudo_proj_True n y, pseudo_proj_False n y}" by auto
hence "w = pseudo_proj_True n y ∨ w = pseudo_proj_False n y" by auto
show "w ∈ range (pseudo_proj_True (Suc n)) ∩ f -` {f x}"
proof (cases "w = pseudo_proj_True n y")
case True
hence "f w = f y" using assms nat_filtration_not_borel_info natural_filtration
by (metis comp_apply)
thus ?thesis using ‹f y = f x›
by (simp add: True pseudo_proj_True_Suc_proj pseudo_proj_True_img)
next
case False
hence "f w = f y" using assms nat_filtration_not_borel_info natural_filtration
by (metis Int_iff ‹w ∈ {pseudo_proj_True n y, pseudo_proj_False n y}›
comp_apply pseudo_proj_Suc_preimage singletonD vimage_eq)
thus ?thesis using ‹f y = f x›
using ‹w ∈ {pseudo_proj_True n y, pseudo_proj_False n y}› pseudo_proj_Suc_preimage by auto
qed
qed
qed
also have "... =
(⋃ w∈ {y. f y = f x}.{pseudo_proj_True n w}) ∪ (⋃ w∈ {y. f y = f x}.{pseudo_proj_False n w})" by auto
also have "... = (pseudo_proj_True n) ` {y. f y = f x} ∪ (pseudo_proj_False n) `{y. f y = f x}" by auto
also have "... = (pseudo_proj_True n) ` (f -` {f x}) ∪ (pseudo_proj_False n) ` (f -` {f x})" by auto
finally show ?thesis .
qed
lemma (in infinite_cts_filtration) pseudo_proj_preimage:
assumes "g∈ measurable (F n) N"
and "set_discriminating n g N"
shows "pseudo_proj_True n -` (g -` {g z}) = pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))"
proof
show "pseudo_proj_True n -` g -` {g z} ⊆ pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z}"
proof
fix w
assume "w∈ pseudo_proj_True n -` g -` {g z}"
have "pseudo_proj_True n w = pseudo_proj_True n (pseudo_proj_True n w)"
by (simp add: pseudo_proj_True_proj)
also have "... ∈ pseudo_proj_True n `(g -` {g z})" using ‹w∈ pseudo_proj_True n -` g -` {g z}›
by simp
finally have "pseudo_proj_True n w ∈ pseudo_proj_True n `(g -` {g z})" .
thus "w∈ pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))" by simp
qed
show "pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z} ⊆ pseudo_proj_True n -` g -` {g z}"
proof
fix w
assume "w ∈ pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z}"
hence "∃y. pseudo_proj_True n w = pseudo_proj_True n y ∧ g y = g z" by auto
from this obtain y where "pseudo_proj_True n w = pseudo_proj_True n y" and "g y = g z" by auto
have "g (pseudo_proj_True n w) = g (pseudo_proj_True n y)" using ‹pseudo_proj_True n w = pseudo_proj_True n y›
by simp
also have "... = g y" using assms nat_filtration_not_borel_info natural_filtration by (metis comp_apply)
also have "... = g z" using ‹g y = g z› .
finally have "g (pseudo_proj_True n w) = g z" .
thus "w∈ pseudo_proj_True n -` g -` {g z}" by simp
qed
qed
lemma (in infinite_cts_filtration) borel_pseudo_proj_preimage:
fixes g::"bool stream ⇒ 'b::{t0_space}"
assumes "g∈ borel_measurable (F n)"
shows "pseudo_proj_True n -` (g -` {g z}) = pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))"
using pseudo_proj_preimage[of g n borel z] set_discriminating_if[of g n] natural_filtration assms by simp
lemma (in infinite_cts_filtration) pseudo_proj_False_preimage:
assumes "g∈ measurable (F n) N"
and "set_discriminating n g N"
shows "pseudo_proj_False n -` (g -` {g z}) = pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))"
proof
show "pseudo_proj_False n -` g -` {g z} ⊆ pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z}"
proof
fix w
assume "w∈ pseudo_proj_False n -` g -` {g z}"
have "pseudo_proj_False n w = pseudo_proj_False n (pseudo_proj_False n w)"
using pseudo_proj_False_def pseudo_proj_False_stake by auto
also have "... ∈ pseudo_proj_False n `(g -` {g z})" using ‹w∈ pseudo_proj_False n -` g -` {g z}›
by simp
finally have "pseudo_proj_False n w ∈ pseudo_proj_False n `(g -` {g z})" .
thus "w∈ pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))" by simp
qed
show "pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z} ⊆ pseudo_proj_False n -` g -` {g z}"
proof
fix w
assume "w ∈ pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z}"
hence "∃y. pseudo_proj_False n w = pseudo_proj_False n y ∧ g y = g z" by auto
from this obtain y where "pseudo_proj_False n w = pseudo_proj_False n y" and "g y = g z" by auto
have "g (pseudo_proj_False n w) = g (pseudo_proj_False n y)" using ‹pseudo_proj_False n w = pseudo_proj_False n y›
by simp
also have "... = g y" using assms nat_filtration_not_borel_info' natural_filtration by (metis comp_apply)
also have "... = g z" using ‹g y = g z› .
finally have "g (pseudo_proj_False n w) = g z" .
thus "w∈ pseudo_proj_False n -` g -` {g z}" by simp
qed
qed
lemma (in infinite_cts_filtration) borel_pseudo_proj_False_preimage:
fixes g::"bool stream ⇒ 'b::{t0_space}"
assumes "g∈ borel_measurable (F n)"
shows "pseudo_proj_False n -` (g -` {g z}) = pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))"
using pseudo_proj_False_preimage[of g n borel z] set_discriminating_if[of g n] natural_filtration assms by simp
lemma (in infinite_cts_filtration) pseudo_proj_preimage':
assumes "g∈ measurable (F n) N"
and "set_discriminating n g N"
shows "pseudo_proj_True n -` (g -` {g z}) = g -` {g z}"
proof
show "pseudo_proj_True n -` g -` {g z} ⊆ g -` {g z}"
proof
fix w
assume "w∈ pseudo_proj_True n -` g -` {g z}"
have "g w = g (pseudo_proj_True n w)" using assms nat_filtration_not_borel_info natural_filtration
by (metis comp_apply)
also have "... = g z" using ‹w∈ pseudo_proj_True n -` g -` {g z}› by simp
finally have "g w = g z".
thus "w∈ g -`{g z}" by simp
qed
show "g -` {g z} ⊆ pseudo_proj_True n -` g -` {g z}"
proof
fix w
assume "w ∈ g -` {g z}"
have "g (pseudo_proj_True n w) = g w" using assms nat_filtration_not_borel_info natural_filtration
by (metis comp_apply)
also have "... = g z" using ‹w∈ g -`{g z}› by simp
finally have "g (pseudo_proj_True n w) = g z" .
thus "w∈ pseudo_proj_True n -` g -` {g z}" by simp
qed
qed
lemma (in infinite_cts_filtration) borel_pseudo_proj_preimage':
fixes g::"bool stream ⇒ 'b::{t0_space}"
assumes "g∈ borel_measurable (F n)"
shows "pseudo_proj_True n -` (g -` {g z}) = g -` {g z}"
using assms natural_filtration by (simp add: set_discriminating_if pseudo_proj_preimage')
lemma (in infinite_cts_filtration) pseudo_proj_False_preimage':
assumes "g∈ measurable (F n) N"
and "set_discriminating n g N"
shows "pseudo_proj_False n -` (g -` {g z}) = g -` {g z}"
proof
show "pseudo_proj_False n -` g -` {g z} ⊆ g -` {g z}"
proof
fix w
assume "w∈ pseudo_proj_False n -` g -` {g z}"
have "g w = g (pseudo_proj_False n w)" using assms nat_filtration_not_borel_info' natural_filtration
by (metis comp_apply)
also have "... = g z" using ‹w∈ pseudo_proj_False n -` g -` {g z}› by simp
finally have "g w = g z".
thus "w∈ g -`{g z}" by simp
qed
show "g -` {g z} ⊆ pseudo_proj_False n -` g -` {g z}"
proof
fix w
assume "w ∈ g -` {g z}"
have "g (pseudo_proj_False n w) = g w" using assms nat_filtration_not_borel_info' natural_filtration
by (metis comp_apply)
also have "... = g z" using ‹w∈ g -`{g z}› by simp
finally have "g (pseudo_proj_False n w) = g z" .
thus "w∈ pseudo_proj_False n -` g -` {g z}" by simp
qed
qed
lemma (in infinite_cts_filtration) borel_pseudo_proj_False_preimage':
fixes g::"bool stream ⇒ 'b::{t0_space}"
assumes "g∈ borel_measurable (F n)"
shows "pseudo_proj_False n -` (g -` {g z}) = g -` {g z}"
using assms natural_filtration by (simp add: set_discriminating_if pseudo_proj_False_preimage')
subsubsection ‹Integrals and conditional expectations on the natural filtration›
lemma (in infinite_cts_filtration) cst_integral:
fixes f::"bool stream⇒real"
assumes "f ∈ borel_measurable (F 0)"
and "f (sconst True) = c"
shows "has_bochner_integral M f c"
proof -
have "space M = space (F 0)" using filtration by (simp add: filtration_def subalgebra_def)
have "f∈ borel_measurable M"
using assms(1) nat_filtration_borel_measurable_integrable natural_filtration by blast
have "∃d. ∀x∈ space (F 0). f x = d"
proof (rule triv_measurable_cst)
show "space (F 0) = space M" using ‹space M = space (F 0)› ..
show "sets (F 0) = {{}, space M}" using info_disc_filtr
by (simp add: init_triv_filt_def bot_nat_def)
show "f ∈ borel_measurable (F 0)" using assms by simp
show "space M ≠ {}" by (simp add:not_empty)
qed
from this obtain d where "∀x∈ space (F 0). f x = d" by auto
hence "∀ x∈ space M. f x = d" using ‹space M = space (F 0)› by simp
hence "f (sconst True) = d" using bernoulli_stream_space bernoulli by simp
hence "c = d" using assms by simp
hence "∀x∈ space M. f x = c" using ‹∀ x∈ space M. f x = d› ‹c = d› by simp
have "f∈ borel_measurable M"
using assms(1) nat_filtration_borel_measurable_integrable natural_filtration by blast
have "integral⇧N M f = integral⇧N M (λw. c)"
proof (rule nn_integral_cong)
fix x
assume "x∈ space M"
thus "ennreal (f x) = ennreal c" using ‹∀ x∈ space M. f x = d› ‹c = d› by auto
qed
also have "... = integral⇧N M (λw. c * (indicator (space M)) w)"
by (simp add: nn_integral_cong)
also have "... = ennreal c * emeasure M (space M)" using nn_integral_cmult_indicator[of "space M" M c]
by (simp add: nn_integral_cong)
also have "... = ennreal c" by (simp add: emeasure_space_1)
finally have "integral⇧N M f = ennreal c" .
hence "integral⇧N M (λx. - f x) = ennreal (-c)"
by (simp add: ‹∀x∈space M. f x = d› ‹c = d› emeasure_space_1 nn_integral_cong)
show "has_bochner_integral M f c"
proof (cases "0 ≤ c")
case True
hence "AE x in M. 0 ≤ f x" using ‹∀x∈ space M. f x = c› by simp
thus ?thesis using ‹random_variable borel f› True
‹integral⇧N M f = ennreal c› by (simp add: has_bochner_integral_nn_integral)
next
case False
let ?mf = "λw. - f w"
have "AE x in M. 0 ≤ ?mf x" using ‹∀x∈ space M. f x = c› False by simp
hence "has_bochner_integral M ?mf (-c)" using ‹random_variable borel f› False
‹integral⇧N M (λx. - f x) = ennreal (-c)› by (simp add: has_bochner_integral_nn_integral)
thus ?thesis using has_bochner_integral_minus by fastforce
qed
qed
lemma (in infinite_cts_filtration) cst_nn_integral:
fixes f::"bool stream⇒real"
assumes "f ∈ borel_measurable (F 0)"
and "⋀w. 0 ≤ f w"
and "f (sconst True) = c"
shows "integral⇧N M f = ennreal c" using assms cst_integral
by (simp add: assms(1) has_bochner_integral_iff nn_integral_eq_integral)
lemma (in infinite_cts_filtration) suc_measurable:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f∈ borel_measurable (F (Suc n))"
shows "(λw. f (c ## w)) ∈ borel_measurable (F n)"
proof -
have "(λw. f (c ## w)) ∈ borel_measurable (nat_filtration n)"
proof (rule nat_filtration_comp_measurable)
have "f∈ borel_measurable M" using assms
using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
hence "f∈ borel_measurable (stream_space (measure_pmf (bernoulli_pmf p)))" using bernoulli unfolding bernoulli_stream_def by simp
have "(λw. c ## w) ∈ (stream_space (measure_pmf (bernoulli_pmf p)) →⇩M stream_space (measure_pmf (bernoulli_pmf p)))"
proof (rule measurable_Stream)
show "(λx. c) ∈ stream_space (measure_pmf (bernoulli_pmf p)) →⇩M measure_pmf (bernoulli_pmf p)" by simp
show "(λx. x) ∈ stream_space (measure_pmf (bernoulli_pmf p)) →⇩M stream_space (measure_pmf (bernoulli_pmf p))" by simp
qed
hence "(λw. f (c ## w)) ∈ (stream_space (measure_pmf (bernoulli_pmf p)) →⇩M borel)" using ‹f∈ borel_measurable (stream_space (measure_pmf (bernoulli_pmf p)))›
measurable_comp[of "(λw. c ## w)" "stream_space (measure_pmf (bernoulli_pmf p))" "stream_space (measure_pmf (bernoulli_pmf p))" f borel]
by simp
thus "random_variable borel (λw. f (c ## w))" using bernoulli unfolding bernoulli_stream_def by simp
have "∀w. f (c ## (pseudo_proj_True n w)) = f (c##w)"
proof
fix w
have "c## (pseudo_proj_True n w) = pseudo_proj_True (Suc n) (c##w)" unfolding pseudo_proj_True_def by simp
hence "f (c ## (pseudo_proj_True n w)) = f (pseudo_proj_True (Suc n) (c##w))" by simp
also have "... = f (c##w)" using assms nat_filtration_info[of f "Suc n"] natural_filtration
by (metis comp_apply)
finally show "f (c ## (pseudo_proj_True n w)) = f (c##w)" .
qed
thus "(λw. f (c ## w)) ∘ pseudo_proj_True n = (λw. f (c ## w))" by auto
qed
thus "(λw. f (c ## w)) ∈ borel_measurable (F n)" using natural_filtration by simp
qed
lemma (in infinite_cts_filtration) F_n_nn_integral_pos:
fixes f::"bool stream⇒real"
shows "⋀f. (∀x. 0 ≤ f x) ⟹ f ∈ borel_measurable (F n) ⟹ integral⇧N M f =
(∑ w∈ range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)) * ennreal (f w))"
proof (induct n)
case 0
have "range (pseudo_proj_True 0) = {sconst True}"
proof
have "⋀w. pseudo_proj_True 0 w = sconst True"
proof -
fix w
show "pseudo_proj_True 0 w = sconst True" unfolding pseudo_proj_True_def by simp
qed
thus "range (pseudo_proj_True 0) ⊆ {sconst True}" by auto
show "{sconst True} ⊆ range (pseudo_proj_True 0)"
using ‹range (pseudo_proj_True 0) ⊆ {sconst True}› subset_singletonD by fastforce
qed
hence "(emeasure M ((pseudo_proj_True 0) -`{sconst True} ∩ space M)) = ennreal 1"
by (metis Int_absorb1 UNIV_I emeasure_eq_measure image_eqI prob_space subsetI vimage_eq)
have "(∑ w∈ range (pseudo_proj_True 0). f w) = (∑ w∈ {sconst True}. f w)" using ‹range (pseudo_proj_True 0) = {sconst True}›
sum.cong[of "range (pseudo_proj_True n)" "{sconst True}" f f] by simp
also have "... = f (sconst True)" by simp
finally have "(∑ w∈ range (pseudo_proj_True 0). f w) = f (sconst True)" .
hence "(∑ w∈ range (pseudo_proj_True 0). (emeasure M ((pseudo_proj_True 0) -`{w} ∩ space M)) * f w) = f (sconst True)"
using ‹(emeasure M ((pseudo_proj_True 0) -`{sconst True} ∩ space M)) = ennreal 1›
by (simp add: ‹range (pseudo_proj_True 0) = {sconst True}›)
thus "integral⇧N M f = (∑ w∈ range (pseudo_proj_True 0). (emeasure M ((pseudo_proj_True 0) -`{w} ∩ space M)) * f w)"
using 0 by (simp add:cst_nn_integral)
next
case (Suc n)
define BP where "BP = measure_pmf (bernoulli_pmf p)"
have "integral⇧N M f = integral⇧N (stream_space BP) f" using bernoulli
unfolding bernoulli_stream_def BP_def by simp
also have "... = ∫⇧+ x. ∫⇧+ X. f (x ## X) ∂stream_space BP ∂BP"
proof (rule prob_space.nn_integral_stream_space)
show "prob_space BP" unfolding BP_def by (simp add: bernoulli bernoulli_stream_def
prob_space.prob_space_stream_space prob_space_measure_pmf)
have "f∈ borel_measurable (stream_space BP)" using bernoulli Suc unfolding bernoulli_stream_def BP_def
using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
thus "(λX. ennreal (f X)) ∈ borel_measurable (stream_space BP)" by simp
qed
also have "... = (λx. (∫⇧+ X. f (x ## X) ∂stream_space BP)) True * ennreal p +
(λx. (∫⇧+ X. f (x ## X) ∂stream_space BP)) False * ennreal (1 -p)"
using p_gt_0 p_lt_1 unfolding BP_def by simp
also have "... = (∫⇧+ X. f (True ## X) ∂stream_space BP) * p +
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w))) * (1-p)"
proof -
define ff where "ff = (λw. f (False ## w))"
have "⋀x. 0 ≤ ff x" using Suc unfolding ff_def by simp
moreover have "ff∈ borel_measurable (F n)" using Suc unfolding ff_def by (simp add:suc_measurable)
ultimately have "(∫⇧+ x. ennreal (ff x) ∂M) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (ff w))"
using Suc by simp
thus ?thesis unfolding ff_def by (simp add: BP_def bernoulli bernoulli_stream_def)
qed
also have "... = (∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (True ## w))) * p +
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w))) * (1-p)"
proof -
define ft where "ft = (λw. f (True ## w))"
have "⋀x. 0 ≤ ft x" using Suc unfolding ft_def by simp
moreover have "ft∈ borel_measurable (F n)" using Suc unfolding ft_def by (simp add:suc_measurable)
ultimately have "(∫⇧+ x. ennreal (ft x) ∂M) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (ft w))"
using Suc by simp
thus ?thesis unfolding ft_def by (simp add: BP_def bernoulli bernoulli_stream_def)
qed
also have "... = (∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w))) +
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w)))* (1-p)"
proof -
have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (True ## w))) * p =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (True ## w)) * p)"
by (rule sum_distrib_right)
also have "... = (∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w)))"
proof (rule sum.cong, simp)
fix w
assume "w∈ range (pseudo_proj_True n)"
show "emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (f (True ## w)) * ennreal p =
emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal p * ennreal (f (True ## w))"
proof -
have "ennreal (f (True ## w)) * ennreal p = ennreal p * ennreal (f (True ## w))" by (simp add:mult.commute)
hence "⋀x. x * ennreal (f (True ## w)) * ennreal p = x * ennreal p * ennreal (f (True ## w))"
by (simp add: semiring_normalization_rules(16))
thus ?thesis by simp
qed
qed
finally have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (True ## w))) * p =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w)))" .
thus ?thesis by simp
qed
also have "... = (∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w))) +
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w)))"
proof -
have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w))) * (1-p) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w)) * (1-p))"
by (rule sum_distrib_right)
also have "... = (∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w)))"
proof (rule sum.cong, simp)
fix w
assume "w∈ range (pseudo_proj_True n)"
show "emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (f (False ## w)) * ennreal (1-p) =
emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (1-p) * ennreal (f (False ## w))"
proof -
have "ennreal (f (False ## w)) * ennreal (1-p) = ennreal (1-p) * ennreal (f (False ## w))" by (simp add:mult.commute)
hence "⋀x. x * ennreal (f (False ## w)) * ennreal (1-p) = x * ennreal (1-p) * ennreal (f (False ## w))"
by (simp add: semiring_normalization_rules(16))
thus ?thesis by simp
qed
qed
finally have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (f (False ## w))) * (1-p) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w)))" .
thus ?thesis by simp
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p * (f (y))) +
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w)))"
proof -
have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w))) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {stl (True##w)} ∩ space M) * p * (f (True ## w)))" by simp
also have "... =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p * (f (y)))"
by (rule reindex_pseudo_proj)
finally have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * p * (f (True ## w))) =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p * (f (y)))" .
thus ?thesis by simp
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p * (f (y))) +
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) * (f (y)))"
proof -
have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w))) =
(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {stl (False##w)} ∩ space M) * (1-p) * (f (False ## w)))" by simp
also have "... =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) * (f (y)))"
by (rule reindex_pseudo_proj)
finally have "(∑w∈range (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w} ∩ space M) * (1-p) * (f (False ## w))) =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) * (f (y)))" .
thus ?thesis by simp
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f (y))) +
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) * (f (y)))"
proof -
have "∀y ∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p =
prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)"
proof
fix y
assume "y ∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}"
hence "∃w ∈ range (pseudo_proj_True n). y = True ## w" by simp
from this obtain w where "w∈ range (pseudo_proj_True n)" and "y = True ## w" by auto
have "emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p = p *emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)"
by (simp add:mult.commute)
also have "... = prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)" using ‹y = True ## w›
unfolding prob_component_def by simp
finally show "emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * p =
prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)" .
qed
thus ?thesis by auto
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f (y))) +
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f (y)))"
proof -
have "∀y ∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) =
prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)"
proof
fix y
assume "y ∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}"
hence "∃w ∈ range (pseudo_proj_True n). y = False ## w" by simp
from this obtain w where "w∈ range (pseudo_proj_True n)" and "y = False ## w" by auto
have "emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) = (1-p) *emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)"
by (simp add:mult.commute)
also have "... = prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)" using ‹y = False ## w›
unfolding prob_component_def by simp
finally show "emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (1-p) =
prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M)" .
qed
thus ?thesis by auto
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = True ## x} * (f y)) +
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f (y)))"
proof -
have "(∑y | ∃w∈range (pseudo_proj_True n). y = True ## w.
ennreal (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f y)) =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = True ## x} * (f y))"
proof (rule sum.cong, simp)
fix xx
assume "xx ∈ {y. ∃w∈range (pseudo_proj_True n). y = True ## w}"
hence "∃w∈range (pseudo_proj_True n). xx = True ## w" by simp
from this obtain ww where "ww∈range (pseudo_proj_True n)" and "xx = True## ww" by auto
have "ennreal (prob_component p (True##ww) 0) * emeasure M (pseudo_proj_True n -` {ww} ∩ space M) =
emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {ww}. z = True ## x}" using ‹ww∈range (pseudo_proj_True n)›
by (rule pseudo_proj_element_prob_pref[symmetric])
thus "ennreal (prob_component p xx 0) * emeasure M (pseudo_proj_True n -` {stl xx} ∩ space M) * (f xx) =
emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl xx}. z = True ## x} * (f xx)" using ‹xx = True##ww› by simp
qed
thus ?thesis by simp
qed
also have "... = (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = True ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = True ## x} * (f y)) +
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = False ## x} * (f y))"
proof -
have "(∑y | ∃w∈range (pseudo_proj_True n). y = False ## w.
ennreal (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y} ∩ space M) * (f y)) =
(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = False ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = False ## x} * (f y))"
proof (rule sum.cong, simp)
fix xx
assume "xx ∈ {y. ∃w∈range (pseudo_proj_True n). y = False ## w}"
hence "∃w∈range (pseudo_proj_True n). xx = False ## w" by simp
from this obtain ww where "ww∈range (pseudo_proj_True n)" and "xx = False## ww" by auto
have "ennreal (prob_component p (False##ww) 0) * emeasure M (pseudo_proj_True n -` {ww} ∩ space M) =
emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {ww}. z = False ## x}" using ‹ww∈range (pseudo_proj_True n)›
by (rule pseudo_proj_element_prob_pref[symmetric])
thus "ennreal (prob_component p xx 0) * emeasure M (pseudo_proj_True n -` {stl xx} ∩ space M) * (f xx) =
emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl xx}. z = False ## x} * (f xx)" using ‹xx = False##ww› by simp
qed
thus ?thesis by simp
qed
also have "... = (∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = True ## x} * (f (True##w))) +
(∑w ∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = False ## x} * (f (False##w)))"
proof -
have "⋀c. (∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = c ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = c ## x} * (f y)) =
(∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = c ## x} * (f (c##w)))"
proof -
fix c
have "(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = c ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = c ## x} * (f y)) =
(∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl (c##w)}. z = c ## x} * (f (c##w)))"
by (rule reindex_pseudo_proj[symmetric])
also have "... = (∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = c ## x} * (f (c##w)))"
by simp
finally show "(∑y∈{y. ∃w ∈ range (pseudo_proj_True n). y = c ## w}. emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl y}. z = c ## x} * (f y)) =
(∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = c ## x} * (f (c##w)))" .
qed
thus ?thesis by auto
qed
also have "... = (∑w∈ {w. w∈ range (pseudo_proj_True (Suc n)) ∧ w!!0 = True}. emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ (space M)) * (f w)) +
(∑w∈ {w. w∈ range (pseudo_proj_True (Suc n)) ∧ w!!0 = False}. emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ (space M)) * (f w))"
proof -
have "⋀c. (∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = c ## x} * (f (c##w))) =
(∑w∈ {w. w∈ range (pseudo_proj_True (Suc n)) ∧ w!!0 = c}. emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ (space M)) * (f w))"
proof -
fix c
show "(∑w∈ range (pseudo_proj_True n). emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {w}. z = c ## x} * (f (c##w))) =
(∑w∈ {w. w∈ range (pseudo_proj_True (Suc n)) ∧ w!!0 = c}. emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ (space M)) * (f w))"
proof (rule sum.reindex_cong)
show "inj_on stl {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
proof
fix x y
assume "x ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
and "y ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
and "stl x = stl y"
have "x!!0 = c" using ‹x ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}› by simp
moreover have "y!!0 = c" using ‹y ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}› by simp
ultimately show "x = y" using ‹stl x= stl y›
by (smt snth.simps(1) stream_eq_Stream_iff)
qed
show "range (pseudo_proj_True n) = stl ` {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
proof
show "range (pseudo_proj_True n) ⊆ stl ` {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
proof
fix x
assume "x∈ range (pseudo_proj_True n)"
hence "pseudo_proj_True n x = x" using pseudo_proj_True_proj by auto
have "pseudo_proj_True (Suc n) (c##x) = c##x"
proof -
have "pseudo_proj_True (Suc n) (c##x) = c ## pseudo_proj_True n x" using pseudo_proj_True_Suc_prefix[of n "c##x"]
by simp
also have "... = c## x" using ‹pseudo_proj_True n x = x› by simp
finally show ?thesis .
qed
hence "c##x∈ range (pseudo_proj_True (Suc n))" by (simp add: pseudo_proj_True_img)
thus "x∈ stl`{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
proof -
have "∃s. (s ∈ range (pseudo_proj_True (Suc n)) ∧ s !! 0 = c) ∧ stl s = x"
by (metis (no_types) ‹c ## x ∈ range (pseudo_proj_True (Suc n))› snth.simps(1) stream.sel(1) stream.sel(2))
then show ?thesis
by force
qed
qed
show "stl ` {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c} ⊆ range (pseudo_proj_True n)"
proof
fix x
assume "x∈ stl ` {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
hence "∃ w∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}. x = stl w" by auto
from this obtain w where "w ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}" and "x = stl w" by auto
have "w∈ range (pseudo_proj_True (Suc n))" and "w!!0 = c" using ‹w ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}›
by auto
have "c##x = w" using ‹x = stl w› ‹w!!0 = c› by force
also have "... = pseudo_proj_True (Suc n) w" using ‹w∈ range (pseudo_proj_True (Suc n))›
using pseudo_proj_True_proj by auto
also have "... = c ## pseudo_proj_True n x" using ‹x = stl w› ‹w!!0 = c› by (simp add:pseudo_proj_True_Suc_prefix)
finally have "c##x = c## pseudo_proj_True n x" .
hence "x = pseudo_proj_True n x" by simp
thus "x∈ range (pseudo_proj_True n)" by auto
qed
qed
show "⋀x. x ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c} ⟹
emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl x}. z = c ## x} * ennreal (f (c ## stl x)) =
emeasure M (pseudo_proj_True (Suc n) -` {x} ∩ space M) * ennreal (f x)"
proof -
fix w
assume "w ∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = c}"
hence "w ∈ range (pseudo_proj_True (Suc n))" and "w !! 0 = c" by auto
have "{z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x} = (pseudo_proj_True (Suc n) -` {w} ∩ space M)"
proof
show "{z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x} ⊆ pseudo_proj_True (Suc n) -` {w} ∩ space M"
proof
fix z
assume "z ∈ {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x}"
hence "∃x∈pseudo_proj_True n -` {stl w}. z = c ## x" and "z∈ space M" by auto
from ‹∃x∈pseudo_proj_True n -` {stl w}. z = c ## x› obtain x where "x∈pseudo_proj_True n -` {stl w}"
and "z = c##x" by auto
have "pseudo_proj_True (Suc n) z = c ## pseudo_proj_True n x" using ‹z = c##x›
by (simp add:pseudo_proj_True_Suc_prefix)
also have "... = c## stl w" using ‹x∈pseudo_proj_True n -` {stl w}› by simp
also have "... = w" using ‹w !! 0 = c› by force
finally have "pseudo_proj_True (Suc n) z = w" .
thus "z∈ pseudo_proj_True (Suc n) -` {w} ∩ space M" using ‹z∈ space M› by auto
qed
show "pseudo_proj_True (Suc n) -` {w} ∩ space M ⊆ {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x}"
proof
fix z
assume "z∈ pseudo_proj_True (Suc n) -` {w} ∩ space M"
hence "z∈ space M" and "pseudo_proj_True (Suc n) z = w" by auto
hence "stl w = stl (pseudo_proj_True (Suc n) z)" by simp
also have "... = pseudo_proj_True n (stl z)" by (simp add: pseudo_proj_True_Suc_prefix)
finally have "stl w = pseudo_proj_True n (stl z)" .
hence "stl z ∈ pseudo_proj_True n -` {stl w}" by simp
have "z!!0 ## pseudo_proj_True n (stl z) = w" using pseudo_proj_True_Suc_prefix
‹pseudo_proj_True (Suc n) z = w› by simp
also have "... = c## (stl w)" using ‹w!!0 = c› by force
finally have "z!!0 ## pseudo_proj_True n (stl z) = c## (stl w)" .
hence "z!!0 = c" by simp
hence "z =c## (stl z)" by force
thus "z∈ {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x}" using ‹z∈ space M›
‹stl z ∈ pseudo_proj_True n -` {stl w}› by auto
qed
qed
hence "emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x} * ennreal (f (c ## stl w)) =
emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f (c ## stl w))" by simp
also have "... = emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f w)" using ‹w!!0 = c› by force
finally show "emeasure M {z ∈ space M. ∃x∈pseudo_proj_True n -` {stl w}. z = c ## x} * ennreal (f (c ## stl w)) =
emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f w)" .
qed
qed
qed
thus ?thesis by simp
qed
also have "... = (∑w∈ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True} ∪
{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False}.
emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f w))"
proof (rule sum.union_disjoint[symmetric])
show "finite {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True}" by (simp add: pseudo_proj_True_finite_image)
show "finite {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False}" by (simp add: pseudo_proj_True_finite_image)
show "{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True} ∩ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False} = {}"
by auto
qed
also have "... = (∑w∈ range (pseudo_proj_True (Suc n)).emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f w))"
proof (rule sum.cong)
show "{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True} ∪ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False} =
range (pseudo_proj_True (Suc n))"
proof
show "{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True} ∪ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False}
⊆ range (pseudo_proj_True (Suc n))" by auto
show "range (pseudo_proj_True (Suc n))
⊆ {w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = True} ∪
{w ∈ range (pseudo_proj_True (Suc n)). w !! 0 = False}"
by (simp add: subsetI)
qed
qed simp
finally show "integral⇧N M f =
(∑w∈ range (pseudo_proj_True (Suc n)). emeasure M (pseudo_proj_True (Suc n) -` {w} ∩ space M) * ennreal (f w))" .
qed
lemma (in infinite_cts_filtration) F_n_integral_pos:
fixes f::"bool stream⇒real"
assumes "f∈ borel_measurable (F n)"
and "∀w. 0 ≤ f w"
shows "has_bochner_integral M f
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w))"
proof -
have "integral⇧N M f = (∑ w∈ range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w))"
using assms by (simp add: F_n_nn_integral_pos)
have "integral⇧L M f = enn2real (integral⇧N M f)"
proof (rule integral_eq_nn_integral)
show "AE x in M. 0≤ f x" using assms by simp
show "random_variable borel f" using assms
using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
qed
also have "... = enn2real (∑ w∈ range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w))"
using assms by (simp add: F_n_nn_integral_pos)
also have "... = (∑ w∈ range (pseudo_proj_True n). enn2real ((emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w)))"
proof (rule enn2real_sum)
show "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
show "⋀w. w ∈ range (pseudo_proj_True n) ⟹ emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (f w) < ⊤"
proof -
fix w
assume "w∈ range (pseudo_proj_True n)"
show "emeasure M (pseudo_proj_True n -` {w} ∩ space M) * ennreal (f w) < ⊤"
by (simp add: emeasure_eq_measure ennreal_mult_less_top)
qed
qed
also have "... = (∑ w∈ range (pseudo_proj_True n). ((measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w)))"
by (simp add: Sigma_Algebra.measure_def assms(2) enn2real_mult)
finally have "integral⇧L M f =(∑ w∈ range (pseudo_proj_True n). ((measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w)))" .
moreover have "integrable M f"
proof (rule integrableI_nn_integral_finite)
show "random_variable borel f" using assms
using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
show "AE x in M. 0 ≤ f x" using assms by simp
have "(∫⇧+ x. ennreal (f x) ∂M) = (∑ w∈ range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w))"
using assms by (simp add: F_n_nn_integral_pos)
also have "... = (∑ w∈ range (pseudo_proj_True n). ennreal (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * (f w)))"
proof (rule sum.cong, simp)
fix x
assume "x∈ range (pseudo_proj_True n)"
thus "emeasure M (pseudo_proj_True n -` {x} ∩ space M) * ennreal (f x) =
ennreal (prob (pseudo_proj_True n -` {x} ∩ space M) * f x)"
using assms(2) emeasure_eq_measure ennreal_mult'' by auto
qed
also have "... = ennreal (∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * (f w)))"
proof (rule ennreal_sum)
show "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
show "⋀w. 0 ≤ prob (pseudo_proj_True n -` {w} ∩ space M) * f w"
using assms(2) measure_nonneg zero_le_mult_iff by blast
qed
finally show "(∫⇧+ x. ennreal (f x) ∂M) =
ennreal (∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * (f w)))" .
qed
ultimately show ?thesis using has_bochner_integral_iff by blast
qed
lemma (in infinite_cts_filtration) F_n_integral:
fixes f::"bool stream⇒real"
assumes "f∈ borel_measurable (F n)"
shows "has_bochner_integral M f
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (f w))"
proof -
define fpos where "fpos = (λw. max 0 (f w))"
define fneg where "fneg = (λw. max 0 (-f w))"
have "∀w. 0 ≤ fpos w" unfolding fpos_def by simp
have "∀w. 0 ≤ fneg w" unfolding fneg_def by simp
have "fpos ∈ borel_measurable (F n)" using assms unfolding fpos_def by simp
have "fneg ∈ borel_measurable (F n)" using assms unfolding fneg_def by simp
have "has_bochner_integral M fpos
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fpos w))"
using ‹fpos∈ borel_measurable (F n)› ‹∀w. 0 ≤ fpos w› by (simp add: F_n_integral_pos)
moreover have "has_bochner_integral M fneg
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fneg w))"
using ‹fneg∈ borel_measurable (F n)› ‹∀w. 0 ≤ fneg w› by (simp add: F_n_integral_pos)
ultimately have posd: "has_bochner_integral M (λw. fpos w - fneg w)
((∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fpos w)) -
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fneg w)))"
by (simp add:has_bochner_integral_diff)
have "((∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fpos w)) -
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fneg w))) =
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * fpos w -
(measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * fneg w))"
by (rule sum_subtractf[symmetric])
also have "... =
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * (fpos w - fneg w)))"
proof (rule sum.cong, simp)
fix x
assume "x∈ range (pseudo_proj_True n)"
show "prob (pseudo_proj_True n -` {x} ∩ space M) * fpos x - prob (pseudo_proj_True n -` {x} ∩ space M) * fneg x =
prob (pseudo_proj_True n -` {x} ∩ space M) * (fpos x - fneg x)"
by (rule right_diff_distrib[symmetric])
qed
also have "... =
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * f w))"
proof (rule sum.cong, simp)
fix x
assume "x∈ range (pseudo_proj_True n)"
show "prob (pseudo_proj_True n -` {x} ∩ space M) * (fpos x - fneg x) = prob (pseudo_proj_True n -` {x} ∩ space M) * f x"
unfolding fpos_def fneg_def by auto
qed
finally have "((∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fpos w)) -
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * (fneg w))) =
(∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * f w))" .
hence "has_bochner_integral M (λw. fpos w - fneg w) (∑ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M) * f w))"
using posd by simp
moreover have "⋀w. fpos w - fneg w = f w" unfolding fpos_def fneg_def by auto
ultimately show ?thesis using has_bochner_integral_diff by simp
qed
lemma (in infinite_cts_filtration) F_n_integral_prob_comp:
fixes f::"bool stream⇒real"
assumes "f∈ borel_measurable (F n)"
shows "has_bochner_integral M f
(∑ w∈ range (pseudo_proj_True n). (prod (prob_component p w) {0..<n}) * (f w))"
proof -
have "∀ w∈ range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w} ∩ space M)) * f w =
(prod (prob_component p w) {0..<n}) * (f w)"
proof
fix w
assume "w∈ range (pseudo_proj_True n)"
thus "prob (pseudo_proj_True n -` {w} ∩ space M) * f w = prod (prob_component p w) {0..<n} * f w"
using bernoulli_stream_pseudo_prob bernoulli p_lt_1 p_gt_0 by simp
qed
thus ?thesis using F_n_integral assms by (metis (no_types, lifting) sum.cong)
qed
lemma (in infinite_cts_filtration) expect_prob_comp:
fixes f::"bool stream⇒real"
assumes "f∈ borel_measurable (F n)"
shows "expectation f =
(∑ w∈ range (pseudo_proj_True n). (prod (prob_component p w) {0..<n}) * (f w))"
using assms F_n_integral_prob_comp has_bochner_integral_iff by blast
lemma sum_union_disjoint':
assumes "finite A"
and "finite B"
and "A ∩ B = {}"
and "A ∪ B = C"
shows "sum g C = sum g A + sum g B"
using sum.union_disjoint[OF assms(1-3)] and assms(4) by auto
lemma (in infinite_cts_filtration) borel_Suc_expectation:
fixes f::"bool stream⇒ real"
assumes "f∈ borel_measurable (F (Suc n))"
and "g∈ measurable (F n) N"
and "set_discriminating n g N"
and "g -` {g z} ∈ sets (F n)"
and "∀y z. (g y = g z ∧ snth y n = snth z n) ⟶ f y = f z"
shows "expectation (λx. f x * indicator (g -` {g z}) x) =
prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
(1 -p) * f (pseudo_proj_False n z))"
proof -
define expind where "expind = (λx. f x * indicator (g -` {g z}) x)"
have "expind∈ borel_measurable (F (Suc n))" unfolding expind_def
proof (rule borel_measurable_times, (simp add:assms(1,2)))
show "indicator (g -` {g z}) ∈ borel_measurable (F (Suc n))"
proof (rule borel_measurable_indicator)
have "g -` {g z} ∈ sets (nat_filtration n)"
using assms nat_filtration_borel_measurable_singleton natural_filtration by simp
hence "g -` {g z} ∈ sets (F n)" using natural_filtration by simp
thus "g -` {g z} ∈ sets (F (Suc n))"
using nat_filtration_Suc_sets natural_filtration by blast
qed
qed
hence "expectation expind =
(∑ w∈ range (pseudo_proj_True (Suc n)). (measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * (expind w))"
by (simp add:F_n_integral has_bochner_integral_integral_eq)
also have "... = (∑ w∈ range (pseudo_proj_True (Suc n)) ∩ g -` {g z}.
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * (expind w)) +
(∑ w∈ range (pseudo_proj_True (Suc n)) - g -` {g z}.
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * (expind w))"
by (simp add: Int_Diff_Un Int_Diff_disjoint assms sum_union_disjoint' pseudo_proj_True_finite_image)
also have "... = (∑ w∈ range (pseudo_proj_True (Suc n)) ∩ g -` {g z}.
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * (expind w))"
proof -
have "∀w∈ range (pseudo_proj_True (Suc n)) - g -` {g z}. expind w = 0"
proof
fix w
assume "w∈ range (pseudo_proj_True (Suc n)) - g -` {g z}"
thus "expind w = 0" unfolding expind_def by simp
qed
thus ?thesis by simp
qed
also have "... = (∑ w∈ range (pseudo_proj_True (Suc n)) ∩ g -` {g z}.
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * f w)"
proof -
have "∀w∈ range (pseudo_proj_True (Suc n)) ∩ g -` {g z}. expind w = f w"
proof
fix w
assume "w∈ range (pseudo_proj_True (Suc n)) ∩ g -` {g z}"
hence "w∈ g -`{g z}" by simp
thus "expind w = f w" unfolding expind_def by simp
qed
thus ?thesis by simp
qed
also have "... = (∑ w∈ (pseudo_proj_True n) ` (g -` {g z}) ∪ (pseudo_proj_False n) ` (g -` {g z}).
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * f w)" using f_borel_Suc_preimage[of g] assms(1,2, 3) by auto
also have "... = (∑ w∈ (pseudo_proj_True n) ` (g -` {g z}).
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * f w) +
(∑w∈ (pseudo_proj_False n) ` (g -` {g z}).
(measure M ((pseudo_proj_True (Suc n)) -`{w} ∩ space M)) * f w)"
proof (rule sum_union_disjoint')
show "finite (pseudo_proj_True n ` g -` {g z})"
proof -
have "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
moreover have "pseudo_proj_True n ` g -` {g z} ⊆ range (pseudo_proj_True n)"
by (simp add: image_mono)
ultimately show ?thesis by (simp add:finite_subset)
qed
show "finite (pseudo_proj_False n ` g -` {g z})"
proof -
have "finite (range (pseudo_proj_False n))"
by (metis image_subsetI infinite_super proj_rep_set proj_rep_set_finite pseudo_proj_True_Suc_False_proj rangeI)
moreover have "pseudo_proj_False n ` g -` {g z} ⊆ range (pseudo_proj_False n)"
by (simp add: image_mono)
ultimately show ?thesis by (simp add:finite_subset)
qed
show "pseudo_proj_True n ` g -` {g z} ∩ pseudo_proj_False n ` g -` {g z} = {}"
proof (rule ccontr)
assume "pseudo_proj_True n ` g -` {g z} ∩ pseudo_proj_False n ` g -` {g z} ≠ {}"
hence "∃y. y∈ pseudo_proj_True n ` g -` {g z} ∩ pseudo_proj_False n ` g -` {g z}" by auto
from this obtain y where "y∈ pseudo_proj_True n ` g -` {g z}" and "y∈ pseudo_proj_False n ` g -` {g z}" by auto
have "∃yt. yt∈ g -`{g z} ∧ y = pseudo_proj_True n yt" using ‹y∈ pseudo_proj_True n ` g -` {g z}› by auto
from this obtain yt where "y = pseudo_proj_True n yt" by auto
have "∃yf. yf∈ g -`{g z} ∧ y = pseudo_proj_False n yf" using ‹y∈ pseudo_proj_False n ` g -` {g z}› by auto
from this obtain yf where "y = pseudo_proj_False n yf" by auto
have "snth y n = True" using ‹y = pseudo_proj_True n yt› unfolding pseudo_proj_True_def by simp
moreover have "snth y n = False" using ‹y = pseudo_proj_False n yf› unfolding pseudo_proj_False_def by simp
ultimately show False by simp
qed
qed simp
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M) * f (pseudo_proj_True n z)) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M) * f w)"
proof -
define zt where "zt = pseudo_proj_True n z"
have eqw: "⋀w. w∈pseudo_proj_True n ` g -` {g z} ⟹ (g w = g zt ∧ snth w n = snth zt n)"
proof
fix w
assume "w∈ pseudo_proj_True n ` g -` {g z}"
hence "∃y. w = pseudo_proj_True n y ∧ g y = g z" by auto
from this obtain yt where "w = pseudo_proj_True n yt" and "g yt = g z" by auto
have "g w= g yt" using ‹w = pseudo_proj_True n yt› nat_filtration_not_borel_info[of g] natural_filtration
assms by (metis comp_apply)
also have "... = g zt" using assms using nat_filtration_not_borel_info[of g] natural_filtration ‹g yt = g z›
unfolding zt_def by (metis comp_apply)
finally show "g w = g zt" .
show "w !! n = zt !! n" using ‹w = pseudo_proj_True n yt› unfolding zt_def pseudo_proj_True_def by simp
qed
hence "⋀w. w∈pseudo_proj_True n ` g -` {g z} ⟹ f w = f zt"
proof
fix w
assume "w ∈ pseudo_proj_True n ` g -` {g z}"
hence "g w = g zt ∧ snth w n = snth zt n" using eqw [of w] by simp
thus "f w = f zt" using assms(5) by blast
qed
thus ?thesis by simp
qed
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M) * f (pseudo_proj_True n z)) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M) * f (pseudo_proj_False n z))"
proof -
define zf where "zf = pseudo_proj_False n z"
have eqw: "⋀w. w∈pseudo_proj_False n ` g -` {g z} ⟹ (g w = g zf ∧ snth w n = snth zf n)"
proof
fix w
assume "w∈ pseudo_proj_False n ` g -` {g z}"
hence "∃y. w = pseudo_proj_False n y ∧ g y = g z" by auto
from this obtain yf where "w = pseudo_proj_False n yf" and "g yf = g z" by auto
have "g w= g yf" using ‹w = pseudo_proj_False n yf› nat_filtration_not_borel_info'[of g] natural_filtration
assms by (metis comp_apply)
also have "... = g zf" using assms using nat_filtration_not_borel_info'[of g] natural_filtration ‹g yf = g z›
unfolding zf_def by (metis comp_apply)
finally show "g w = g zf" .
show "w !! n = zf !! n" using ‹w = pseudo_proj_False n yf› unfolding zf_def pseudo_proj_False_def by simp
qed
hence "⋀w. w∈pseudo_proj_False n ` g -` {g z} ⟹ f w = f zf"
proof
fix w
assume "w∈ pseudo_proj_False n ` g -` {g z}"
hence "g w = g zf ∧ snth w n = snth zf n" using eqw [of w] by simp
thus "f w = f zf" using assms by blast
qed
thus ?thesis by simp
qed
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M)) * f (pseudo_proj_True n z) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M)) * f (pseudo_proj_False n z)"
by (simp add: sum_distrib_right)
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w}) * p) * f (pseudo_proj_True n z) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w} ∩ space M)) * f (pseudo_proj_False n z)"
proof -
have "⋀w. w∈pseudo_proj_True n ` g -` {g z} ⟹ (prob (pseudo_proj_True (Suc n) -` {w}) =
(prob ({x. stake n x = stake n w})) * p)"
proof -
fix w
assume "w∈pseudo_proj_True n ` g -` {g z}"
hence "∃y. w = pseudo_proj_True n y ∧ g y = g z" by auto
from this obtain yt where "w = pseudo_proj_True n yt" and "g yt = g z" by auto
hence "snth w n" unfolding pseudo_proj_True_def by simp
have "pseudo_proj_True (Suc n) w = w" using ‹w = pseudo_proj_True n yt›
by (simp add: pseudo_proj_True_Suc_proj)
hence "pseudo_proj_True (Suc n) -` {w} = {x. stake (Suc n) x = stake (Suc n) w}" using pseudo_proj_True_preimage_stake
by simp
hence "prob (pseudo_proj_True (Suc n) -` {w}) = prob {x. stake n x = stake n w} * prob_component p w n"
using bernoulli_stream_element_prob_rec' bernoulli bernoulli_stream_space p_lt_1 p_gt_0 by simp
also have "... = prob {x. stake n x = stake n w} * p" using ‹snth w n› unfolding prob_component_def by simp
finally show "prob (pseudo_proj_True (Suc n) -` {w}) = prob {x. stake n x = stake n w} * p" .
qed
thus ?thesis using bernoulli bernoulli_stream_space by simp
qed
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w}) * p) * f (pseudo_proj_True n z) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w} * (1 -p)) * f (pseudo_proj_False n z)"
proof -
have "⋀w. w∈pseudo_proj_False n ` g -` {g z} ⟹ (prob (pseudo_proj_True (Suc n) -` {w} ∩ space M) =
(prob {x. stake n x = stake n w}) * (1-p))"
proof -
fix w
assume "w∈pseudo_proj_False n ` g -` {g z}"
hence "∃y. w = pseudo_proj_False n y ∧ g y = g z" by auto
from this obtain yt where "w = pseudo_proj_False n yt" and "g yt = g z" by auto
hence "¬snth w n" unfolding pseudo_proj_False_def by simp
have "pseudo_proj_True (Suc n) w = w" using ‹w = pseudo_proj_False n yt›
by (simp add: pseudo_proj_True_Suc_False_proj)
hence "pseudo_proj_True (Suc n) -`{w} = {x. stake (Suc n) x = stake (Suc n) w}" using pseudo_proj_True_preimage_stake
by simp
hence "prob (pseudo_proj_True (Suc n) -`{w}) = prob {x. stake n x = stake n w} * prob_component p w n"
using bernoulli_stream_element_prob_rec' bernoulli bernoulli_stream_space p_lt_1 p_gt_0 by simp
also have "... = prob {x. stake n x = stake n w} * (1-p)" using ‹¬snth w n› unfolding prob_component_def by simp
finally show "prob (pseudo_proj_True (Suc n) -`{w} ∩ space M) = prob {x. stake n x = stake n w} * (1-p)" using bernoulli
bernoulli_stream_space by simp
qed
thus ?thesis by simp
qed
also have "... = (∑w∈pseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) * p * f (pseudo_proj_True n z) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w}) * (1 -p) * f (pseudo_proj_False n z)"
by (simp add:sum_distrib_right)
also have "... = prob (g -` {g z}) * p * f (pseudo_proj_True n z) +
(∑w∈pseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w}) * (1 -p) * f (pseudo_proj_False n z)"
proof -
have projset: "⋀w. w∈pseudo_proj_True n ` g -` {g z} ⟹ {x. stake n x = stake n w} ∈ sets M"
proof -
fix w
assume "w∈ pseudo_proj_True n ` g -` {g z}"
hence "∃y. w = pseudo_proj_True n y" by auto
from this obtain y where "w = pseudo_proj_True n y" by auto
hence "w = pseudo_proj_True n w" by (simp add: pseudo_proj_True_proj)
hence "pseudo_proj_True n -`{w} = {x. stake n x = stake n w}" using pseudo_proj_True_preimage_stake by simp
moreover have "pseudo_proj_True n -`{w} ∈ sets M"
using ‹w = pseudo_proj_True n w› bernoulli bernoulli_stream_space pseudo_proj_True_singleton by auto
ultimately show "{x. stake n x = stake n w} ∈ sets M" by simp
qed
have "(∑w∈pseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) =
prob (⋃w∈pseudo_proj_True n ` g -` {g z}. {x. stake n x = stake n w})"
proof (rule finite_measure_finite_Union[symmetric])
show "finite (pseudo_proj_True n ` g -` {g z})"
by (meson finite_subset image_mono pseudo_proj_True_finite_image subset_UNIV)
show "(λi. {x. stake n x = stake n i}) ` pseudo_proj_True n ` g -` {g z} ⊆ events" using projset by auto
show "disjoint_family_on (λi. {x. stake n x = stake n i}) (pseudo_proj_True n ` g -` {g z})"
unfolding disjoint_family_on_def
proof (intro ballI impI)
fix u v
assume "u ∈ pseudo_proj_True n ` g -` {g z}" and "v∈ pseudo_proj_True n ` g -` {g z}" and "u ≠ v" note uvprops = this
show "{x. stake n x = stake n u} ∩ {x. stake n x = stake n v} = {}"
proof (rule ccontr)
assume "{x. stake n x = stake n u} ∩ {x. stake n x = stake n v} ≠ {}"
hence "∃ uu. uu∈ {x. stake n x = stake n u} ∩ {x. stake n x = stake n v}" by auto
from this obtain uu where "uu∈ {x. stake n x = stake n u} ∩ {x. stake n x = stake n v}" by auto
hence "stake n uu = stake n u" and "stake n uu = stake n v" by auto
moreover have "stake n u ≠ stake n v" by (metis uvprops imageE pseudo_proj_True_proj pseudo_proj_True_stake_image)
ultimately show False by simp
qed
qed
qed
also have "... = prob (⋃w∈pseudo_proj_True n ` g -` {g z}. pseudo_proj_True n -`{w})"
proof -
have "⋀w. w∈pseudo_proj_True n ` g -` {g z} ⟹ {x. stake n x = stake n w} = pseudo_proj_True n -`{w}"
using pseudo_proj_True_preimage_stake pseudo_proj_True_proj by force
hence "(⋃w∈pseudo_proj_True n ` g -` {g z}. {x. stake n x = stake n w}) =
(⋃w∈pseudo_proj_True n ` g -` {g z}. pseudo_proj_True n -`{w})" by auto
thus ?thesis by simp
qed
also have "... = prob (pseudo_proj_True n -`(pseudo_proj_True n ` g -` {g z}))" by (metis vimage_eq_UN)
also have "... = prob (g -` {g z})" using pseudo_proj_preimage[symmetric, of g n N z]
pseudo_proj_preimage'[of g n] assms by simp
finally have "(∑w∈pseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) = prob (g -` {g z})" .
thus ?thesis by simp
qed
also have "... = prob (g -` {g z}) * p * f (pseudo_proj_True n z) +
prob (g -`{g z}) * (1 -p) * f (pseudo_proj_False n z)"
proof -
have projset: "⋀w. w∈pseudo_proj_False n ` g -` {g z} ⟹ {x. stake n x = stake n w} ∈ sets M"
proof -
fix w
assume "w∈ pseudo_proj_False n ` g -` {g z}"
hence "∃y. w = pseudo_proj_False n y" by auto
from this obtain y where "w = pseudo_proj_False n y" by auto
hence "w = pseudo_proj_False n w" using pseudo_proj_False_def pseudo_proj_False_stake by auto
hence "pseudo_proj_False n -`{w} = {x. stake n x = stake n w}" using pseudo_proj_False_preimage_stake by simp
moreover have "pseudo_proj_False n -`{w} ∈ sets M"
using ‹w = pseudo_proj_False n w› bernoulli bernoulli_stream_space pseudo_proj_False_singleton by auto
ultimately show "{x. stake n x = stake n w} ∈ sets M" by simp
qed
have "(∑w∈pseudo_proj_False n ` g -` {g z}. prob ({x. stake n x = stake n w})) =
prob (⋃w∈pseudo_proj_False n ` g -` {g z}. {x. stake n x = stake n w})"
proof (rule finite_measure_finite_Union[symmetric])
show "finite (pseudo_proj_False n ` g -` {g z})"
by (meson finite_subset image_mono pseudo_proj_False_finite_image subset_UNIV)
show "(λi. {x. stake n x = stake n i}) ` pseudo_proj_False n ` g -` {g z} ⊆ events" using projset by auto
show "disjoint_family_on (λi. {x. stake n x = stake n i}) (pseudo_proj_False n ` g -` {g z})"
unfolding disjoint_family_on_def
proof (intro ballI impI)
fix u v
assume "u ∈ pseudo_proj_False n ` g -` {g z}" and "v∈ pseudo_proj_False n ` g -` {g z}" and "u ≠ v" note uvprops = this
show "{x. stake n x = stake n u} ∩ {x. stake n x = stake n v} = {}"
proof (rule ccontr)
assume "{x. stake n x = stake n u} ∩ {x. stake n x = stake n v} ≠ {}"
hence "∃ uu. uu∈ {x. stake n x = stake n u} ∩ {x. stake n x = stake n v}" by auto
from this obtain uu where "uu∈ {x. stake n x = stake n u} ∩ {x. stake n x = stake n v}" by auto
hence "stake n uu = stake n u" and "stake n uu = stake n v" by auto
moreover have "stake n u ≠ stake n v"
using pseudo_proj_False_def pseudo_proj_False_stake uvprops by auto
ultimately show False by simp
qed
qed
qed
also have "... = prob (⋃w∈pseudo_proj_False n ` g -` {g z}. pseudo_proj_False n -`{w})"
proof -
have "⋀w. w∈pseudo_proj_False n ` g -` {g z} ⟹ {x. stake n x = stake n w} = pseudo_proj_False n -`{w}"
using pseudo_proj_False_preimage_stake pseudo_proj_False_def pseudo_proj_False_stake by force
hence "(⋃w∈pseudo_proj_False n ` g -` {g z}. {x. stake n x = stake n w}) =
(⋃w∈pseudo_proj_False n ` g -` {g z}. pseudo_proj_False n -`{w})" by auto
thus ?thesis by simp
qed
also have "... = prob (pseudo_proj_False n -`(pseudo_proj_False n ` g -` {g z}))" by (metis vimage_eq_UN)
also have "... = prob (g -` {g z})" using pseudo_proj_False_preimage[symmetric, of g n N z]
pseudo_proj_False_preimage'[of g n] assms by simp
finally have "(∑w∈pseudo_proj_False n ` g -` {g z}. prob ({x. stake n x = stake n w})) = prob (g -` {g z})" .
thus ?thesis by simp
qed
also have "... = prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
(1 -p) * f (pseudo_proj_False n z))"
using distrib_left[symmetric, of "prob (g -` {g z})" "p * f (pseudo_proj_True n z)" "(1 - p) * f (pseudo_proj_False n z)"]
by simp
finally show "expectation (λx. f x * indicator (g -` {g z}) x) =
prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
(1 -p) * f (pseudo_proj_False n z))" unfolding expind_def .
qed
lemma (in infinite_cts_filtration) borel_Suc_expectation_pseudo_proj:
fixes f::"bool stream⇒ real"
assumes "f∈ borel_measurable (F (Suc n))"
shows "expectation (λx. f x * indicator (pseudo_proj_True n -` {pseudo_proj_True n z}) x) =
prob (pseudo_proj_True n -` {pseudo_proj_True n z}) *
(p * (f (pseudo_proj_True n z)) + (1-p) * (f (pseudo_proj_False n z)))"
proof (rule borel_Suc_expectation)
show "f ∈ borel_measurable (F (Suc n))" using assms by simp
show "pseudo_proj_True n ∈ F n →⇩M M"
by (simp add: nat_filtration_pseudo_proj_True_measurable natural_filtration)
show "pseudo_proj_True n -` {pseudo_proj_True n z} ∈ sets (F n)"
by (simp add: nat_filtration_singleton natural_filtration pseudo_proj_True_proj)
show "∀y z. (pseudo_proj_True n y = pseudo_proj_True n z ∧ snth y n = snth z n) ⟶ f y = f z"
proof (intro allI impI conjI)
fix y z
assume "pseudo_proj_True n y = pseudo_proj_True n z ∧ y !! n = z !! n"
hence "pseudo_proj_True n y = pseudo_proj_True n z" and "snth y n = snth z n" by auto
hence "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z" unfolding pseudo_proj_True_def
by (metis (full_types) ‹pseudo_proj_True n y = pseudo_proj_True n z› pseudo_proj_True_same_img stake_Suc)
thus "f y = f z" using nat_filtration_info assms natural_filtration by (metis comp_apply)
qed
show "set_discriminating n (pseudo_proj_True n) M" unfolding set_discriminating_def using pseudo_proj_True_proj by simp
qed
lemma (in infinite_cts_filtration) f_borel_Suc_expl_cond_expect:
assumes "f∈ borel_measurable (F (Suc n))"
and "g∈ measurable (F n) N"
and "set_discriminating n g N"
and "g -` {g w} ∈ sets (F n)"
and "∀y z. (g y = g z ∧ snth y n = snth z n) ⟶ f y = f z"
and "0 < p"
and "p < 1"
shows "expl_cond_expect M g f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof -
have nz:"prob (g -`{g w}) ≠ 0"
proof -
have "pseudo_proj_True n -`{pseudo_proj_True n w} ⊆ g -` {g w}"
proof -
have "∀f n m s. f ∉ F n →⇩M m ∨ ¬ set_discriminating n f m ∨ pseudo_proj_True n -` f -` {f s::'a} = f -` {f s}"
by (meson pseudo_proj_preimage')
then show ?thesis using assms by blast
qed
moreover have "prob (pseudo_proj_True n -`{pseudo_proj_True n w}) > 0" using bernoulli_stream_pref_prob_pos
pseudo_proj_True_preimage_stake bernoulli bernoulli_stream_space emeasure_eq_measure pseudo_proj_True_proj assms by auto
moreover have "pseudo_proj_True n -`{pseudo_proj_True n w} ∈ sets M"
using bernoulli bernoulli_stream_space pseudo_proj_True_proj pseudo_proj_True_singleton by auto
moreover have "g -`{g w} ∈ events" using assms natural_filtration nat_filtration_subalgebra
unfolding subalgebra_def by blast
ultimately show ?thesis using measure_increasing increasingD
proof -
have "g -` {g w} ∉ events ∨ pseudo_proj_True n -` {pseudo_proj_True n w} ∉ events ∨ prob (pseudo_proj_True n -` {pseudo_proj_True n w}) ≤ prob (g -` {g w})"
using ‹pseudo_proj_True n -` {pseudo_proj_True n w} ⊆ g -` {g w}› increasingD measure_increasing by blast
then show ?thesis
using ‹0 < prob (pseudo_proj_True n -` {pseudo_proj_True n w})› ‹g -` {g w} ∈ events› ‹pseudo_proj_True n -` {pseudo_proj_True n w} ∈ events› by linarith
qed
qed
hence "expl_cond_expect M g f w =
expectation (λx. f x * indicator (g -` {g w} ∩ space M) x) /
prob (g -` {g w} ∩ space M)" unfolding expl_cond_expect_def img_dce_def
by simp
also have "... = expectation (λx. f x * indicator (g -` {g w}) x) / prob (g -` {g w})"
using bernoulli by (simp add:bernoulli_stream_space)
also have "... = prob (g -` {g w}) * (p * f (pseudo_proj_True n w) +
(1 -p) * f (pseudo_proj_False n w)) / prob (g -` {g w})"
proof -
have "expectation (λx. f x * indicator (g -` {g w}) x) = prob (g -` {g w}) * (p * f (pseudo_proj_True n w) +
(1 -p) * f (pseudo_proj_False n w))"
proof (rule borel_Suc_expectation)
show "f ∈ borel_measurable (F (Suc n))" using assms by simp
show "g ∈ F n →⇩M N" using assms by simp
show "set_discriminating n g N" using assms by simp
show "g -` {g w} ∈ sets (F n)" using assms by simp
show "∀y z. g y = g z ∧ y !! n = z !! n ⟶ f y = f z" using assms(5) by blast
qed
thus ?thesis by simp
qed
also have "... = p * f (pseudo_proj_True n w) + (1 -p) * f (pseudo_proj_False n w)" using nz by simp
finally show ?thesis .
qed
lemma (in infinite_cts_filtration) f_borel_Suc_real_cond_exp:
assumes "f∈ borel_measurable (F (Suc n))"
and "g∈ measurable (F n) N"
and "set_discriminating n g N"
and "∀w. g -` {g w} ∈ sets (F n)"
and "∀r∈range g ∩ space N. ∃A∈sets N. range g ∩ A = {r}"
and "∀y z. (g y = g z ∧ snth y n = snth z n) ⟶ f y = f z"
and "0 < p"
and "p < 1"
shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N g) f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof -
have "AE w in M. real_cond_exp M (fct_gen_subalgebra M N g) f w = expl_cond_expect M g f w"
proof (rule charact_cond_exp')
show "disc_fct g"
proof -
have "g = g ∘ (pseudo_proj_True n)" using nat_filtration_not_borel_info[of g n] assms natural_filtration by simp
have "disc_fct (pseudo_proj_True n)" unfolding disc_fct_def using pseudo_proj_True_finite_image
by (simp add: countable_finite)
hence "disc_fct (g ∘ (pseudo_proj_True n))" unfolding disc_fct_def
by (metis countable_image image_comp)
thus ?thesis using ‹g = g ∘ (pseudo_proj_True n)› by simp
qed
show "integrable M f" using assms nat_filtration_borel_measurable_integrable natural_filtration by simp
show "random_variable N g" using assms filtration_measurable natural_filtration nat_filtration_subalgebra
using nat_discrete_filtration by blast
show "∀r∈range g ∩ space N. ∃A∈sets N. range g ∩ A = {r}" using assms by simp
qed
moreover have "⋀w. expl_cond_expect M g f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
using assms f_borel_Suc_expl_cond_expect by blast
ultimately show ?thesis by simp
qed
lemma (in infinite_cts_filtration) f_borel_Suc_real_cond_exp_proj:
assumes "f∈ borel_measurable (F (Suc n))"
and "0 < p"
and "p < 1"
shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M M (pseudo_proj_True n)) f w =
p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof (rule f_borel_Suc_real_cond_exp)
show "f ∈ borel_measurable (F (Suc n))" using assms by simp
show "pseudo_proj_True n ∈ F n →⇩M M"
by (simp add: nat_filtration_pseudo_proj_True_measurable natural_filtration)
show "∀w. pseudo_proj_True n -` {pseudo_proj_True n w} ∈ sets (F n)"
proof
fix w
show "pseudo_proj_True n -` {pseudo_proj_True n w} ∈ sets (F n) "
by (simp add: nat_filtration_singleton natural_filtration pseudo_proj_True_proj)
qed
show "∀r∈range (pseudo_proj_True n) ∩ space M. ∃A∈events. range (pseudo_proj_True n) ∩ A = {r}"
proof (intro ballI)
fix r
assume "r ∈ range (pseudo_proj_True n) ∩ space M"
hence "r∈ range (pseudo_proj_True n)" and "r∈ space M" by auto
hence "pseudo_proj_True n r = r" using pseudo_proj_True_proj by auto
hence "(pseudo_proj_True n) -`{r} ∩ space M ∈ sets M" using pseudo_proj_True_singleton bernoulli by simp
moreover have "range (pseudo_proj_True n) ∩ ((pseudo_proj_True n) -`{r} ∩ space M) = {r}"
proof
have "r∈ range (pseudo_proj_True n) ∩ (pseudo_proj_True n -` {r} ∩ space M)"
using ‹pseudo_proj_True n r = r› ‹r ∈ range (pseudo_proj_True n)› ‹r ∈ space M› by blast
thus "{r} ⊆ range (pseudo_proj_True n) ∩ (pseudo_proj_True n -` {r} ∩ space M)" by auto
show "range (pseudo_proj_True n) ∩ (pseudo_proj_True n -` {r} ∩ space M) ⊆ {r}"
proof
fix x
assume "x ∈ range (pseudo_proj_True n) ∩ (pseudo_proj_True n -` {r} ∩ space M)"
hence "x∈ range (pseudo_proj_True n)" and "x∈ (pseudo_proj_True n -` {r})" by auto
have "x = pseudo_proj_True n x" using ‹x∈ range (pseudo_proj_True n)› pseudo_proj_True_proj by auto
also have "... = r" using ‹x∈ (pseudo_proj_True n -` {r})› by simp
finally have "x = r" .
thus "x∈ {r}" by simp
qed
qed
ultimately show "∃A∈events. range (pseudo_proj_True n) ∩ A = {r}" by auto
qed
show "∀y z. pseudo_proj_True n y = pseudo_proj_True n z ∧ y !! n = z !! n ⟶ f y = f z"
proof (intro allI impI conjI)
fix y z
assume "pseudo_proj_True n y = pseudo_proj_True n z ∧ y !! n = z !! n"
hence "pseudo_proj_True n y = pseudo_proj_True n z" and "snth y n = snth z n" by auto
hence "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z" unfolding pseudo_proj_True_def
by (metis (full_types) ‹pseudo_proj_True n y = pseudo_proj_True n z› pseudo_proj_True_same_img stake_Suc)
thus "f y = f z" using nat_filtration_info assms natural_filtration by (metis comp_apply)
qed
show "set_discriminating n (pseudo_proj_True n) M" unfolding set_discriminating_def using pseudo_proj_True_proj by simp
show "0 < p" and "p < 1" using assms by auto
qed
subsection ‹Images of stochastic processes by prefixes of streams›
text ‹We define a function that, given a stream of coin tosses and a stochastic process, returns a stream of the values
of the stochastic process up to a given time. This function will be used to characterize the smallest filtration that,
at any time n, makes each random variable of a given stochastic process measurable up to time n.›
subsubsection ‹Definitions›
primrec smap_stoch_proc where
"smap_stoch_proc 0 f k w = []"
| "smap_stoch_proc (Suc n) f k w = (f k w) # (smap_stoch_proc n f (Suc k) w)"
lemma smap_stoch_proc_length:
shows "length (smap_stoch_proc n f k w) = n"
by (induction n arbitrary:k) auto
lemma smap_stoch_proc_nth:
shows "Suc p ≤ Suc n ⟹ nth (smap_stoch_proc (Suc n) f k w) p = f (k+p) w"
proof (induction n arbitrary:p k)
case 0
hence "p = 0" by simp
hence "(smap_stoch_proc (Suc 0) f k w) ! p = ((f k w) # (smap_stoch_proc 0 f (Suc k) w))!0" by simp
also have "... = f (k+p) w" using ‹p=0› by simp
finally show ?case .
next
case (Suc n)
show ?case
proof (cases "∃m. p = Suc m")
case True
from this obtain m where "p = Suc m" by auto
hence "smap_stoch_proc (Suc (Suc n)) f k w ! p = (smap_stoch_proc (Suc n) f (Suc k) w) ! m" by simp
also have "... = f ((Suc k) + m) w" using Suc(1)[of m] Suc.prems ‹p = Suc m› by blast
also have "... = f (k + (Suc m)) w" by simp
finally show "smap_stoch_proc (Suc (Suc n)) f k w ! p = f (k + p) w" using ‹p = Suc m› by simp
next
case False
hence "p = 0" using less_Suc_eq_0_disj by blast
thus "smap_stoch_proc (Suc (Suc n)) f k w ! p = f (k+p) w" by simp
qed
qed
definition proj_stoch_proc where
"proj_stoch_proc f n = (λw. shift (smap_stoch_proc n f 0 w) (sconst (f n w)))"
lemma proj_stoch_proc_component:
shows "k < n ⟹ (snth (proj_stoch_proc f n w) k) = f k w"
and "n ≤ k ⟹ (snth (proj_stoch_proc f n w) k) = f n w"
proof -
show "k < n ⟹ proj_stoch_proc f n w !! k = f k w"
proof -
assume "k < n"
hence "∃m. n = Suc m" using less_imp_Suc_add by blast
from this obtain m where "n = Suc m" by auto
have "proj_stoch_proc f n w !! k = (smap_stoch_proc n f 0 w) ! k" unfolding proj_stoch_proc_def
using ‹k<n› by (simp add: smap_stoch_proc_length)
also have "... = f k w" using ‹n = Suc m› ‹k < n› smap_stoch_proc_nth
by (metis Suc_leI add.left_neutral)
finally show ?thesis .
qed
show "n ≤ k ⟹ (snth (proj_stoch_proc f n w) k) = f n w"
proof -
assume "n ≤ k"
hence "proj_stoch_proc f n w !! k = (sconst (f n w)) !! (k - n)"
by (simp add: proj_stoch_proc_def smap_stoch_proc_length)
also have "... = f n w" by simp
finally show ?thesis .
qed
qed
lemma proj_stoch_proc_component':
assumes "k ≤ n"
shows "f k x = snth (proj_stoch_proc f n x) k"
proof (cases "k < n")
case True
thus ?thesis using proj_stoch_proc_component[of k n f x] assms by simp
next
case False
hence "k = n" using assms by simp
thus ?thesis using proj_stoch_proc_component[of k n f x] assms by simp
qed
lemma proj_stoch_proc_eq_snth:
assumes "proj_stoch_proc f n x = proj_stoch_proc f n y"
and "k ≤ n"
shows "f k x = f k y"
proof -
have "f k x = snth (proj_stoch_proc f n x) k" using assms proj_stoch_proc_component'[of k n f] by simp
also have "... = snth (proj_stoch_proc f n y) k" using assms by simp
also have "... = f k y" using assms proj_stoch_proc_component'[of k n f] by simp
finally show ?thesis .
qed
lemma proj_stoch_measurable_if_adapted:
assumes "filtration M F"
and "adapt_stoch_proc F f N"
shows "proj_stoch_proc f n ∈ measurable M (stream_space N)"
proof (rule measurable_stream_space2)
fix m
show "(λx. proj_stoch_proc f n x !! m) ∈ M →⇩M N"
proof (cases "m < n")
case True
hence "∀x. proj_stoch_proc f n x !! m = f m x" by (simp add: proj_stoch_proc_component)
hence "(λx. proj_stoch_proc f n x !! m) = f m" by simp
thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
by (metis measurable_from_subalg)
next
case False
hence "∀x. proj_stoch_proc f n x !! m = f n x" by (simp add: proj_stoch_proc_component)
hence "(λx. proj_stoch_proc f n x !! m) = f n" by simp
thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
by (metis measurable_from_subalg)
qed
qed
lemma proj_stoch_adapted_if_adapted:
assumes "filtration M F"
and "adapt_stoch_proc F f N"
shows "proj_stoch_proc f n ∈ measurable (F n) (stream_space N)"
proof (rule measurable_stream_space2)
fix m
show "(λx. proj_stoch_proc f n x !! m) ∈ measurable (F n) N"
proof (cases "m < n")
case True
hence "∀x. proj_stoch_proc f n x !! m = f m x" by (simp add: proj_stoch_proc_component)
hence "(λx. proj_stoch_proc f n x !! m) = f m" by simp
thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
by (metis True measurable_from_subalg not_less order.asym)
next
case False
hence "∀x. proj_stoch_proc f n x !! m = f n x" by (simp add: proj_stoch_proc_component)
hence "(λx. proj_stoch_proc f n x !! m) = f n" by simp
thus ?thesis using assms unfolding adapt_stoch_proc_def by metis
qed
qed
lemma proj_stoch_adapted_if_adapted':
assumes "filtration M F"
and "adapt_stoch_proc F f N"
shows "adapt_stoch_proc F (proj_stoch_proc f) (stream_space N)" unfolding adapt_stoch_proc_def
proof
fix n
show "proj_stoch_proc f n ∈ F n →⇩M stream_space N" using assms by (simp add: proj_stoch_adapted_if_adapted)
qed
lemma (in infinite_cts_filtration) proj_stoch_proj_invariant:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
shows "proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
proof -
have "⋀m. snth (proj_stoch_proc X n w) m = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m"
proof -
fix m
show "snth (proj_stoch_proc X n w) m = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m"
proof (cases "m < n")
case True
hence "snth (proj_stoch_proc X n w) m = X m w" by (simp add: proj_stoch_proc_component)
also have "... = X m (pseudo_proj_True n w)"
proof (rule borel_adapt_nat_filtration_info[symmetric], (simp add:assms))
show "m ≤ n" using True by linarith
qed
also have "... = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m" using True
by (simp add: proj_stoch_proc_component)
finally show ?thesis .
next
case False
hence "snth (proj_stoch_proc X n w) m = X n w" by (simp add: proj_stoch_proc_component)
also have "... = X n (pseudo_proj_True n w)"
by (rule borel_adapt_nat_filtration_info[symmetric]) (auto simp add:assms)
also have "... = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m" using False
by (simp add: proj_stoch_proc_component)
finally show ?thesis .
qed
qed
thus "proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
using diff_streams_only_if by auto
qed
lemma (in infinite_cts_filtration) proj_stoch_set_finite_range:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
shows "finite (range (proj_stoch_proc X n))"
proof -
have "finite (range (pseudo_proj_True n))" using pseudo_proj_True_finite_image by simp
moreover have "proj_stoch_proc X n = (proj_stoch_proc X n) ∘ (pseudo_proj_True n)"
proof
fix x
show "proj_stoch_proc X n x = (proj_stoch_proc X n ∘ pseudo_proj_True n) x"
using assms proj_stoch_proj_invariant by (metis comp_apply)
qed
ultimately show ?thesis
by (metis finite_imageI fun.set_map)
qed
lemma (in infinite_cts_filtration) proj_stoch_set_discriminating:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
shows "set_discriminating n (proj_stoch_proc X n) N"
proof -
have "∀w. proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
using assms proj_stoch_proj_invariant by auto
thus ?thesis unfolding set_discriminating_def by simp
qed
lemma (in infinite_cts_filtration) proj_stoch_preimage:
assumes "borel_adapt_stoch_proc F X"
shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n w} = (⋂i∈ {m. m ≤ n}. (X i) -` {X i w})"
proof
define psX where "psX = proj_stoch_proc X n"
show "proj_stoch_proc X n -` {proj_stoch_proc X n w} ⊆ (⋂i∈{m. m ≤ n}. X i -` {X i w})"
proof
fix x
assume "x ∈ proj_stoch_proc X n -` {proj_stoch_proc X n w}"
hence "psX x = psX w" unfolding psX_def using assms by simp
hence "⋀i. i ∈{m. m ≤ n} ⟹ x ∈ (X i) -`{X i w}"
proof -
fix i
assume "i∈ {m. m≤n}"
hence "i ≤ n" by auto
have "X i x = snth (psX x) i" unfolding psX_def
by (metis Suc_le_eq Suc_le_mono ‹i ≤ n› le_Suc_eq nat.simps(1) proj_stoch_proc_component(1)
proj_stoch_proc_component(2))
also have "... = snth (psX w) i" using ‹psX x = psX w› by simp
also have "... = X i w" unfolding psX_def
by (metis Suc_le_eq Suc_le_mono ‹i ≤ n› le_Suc_eq nat.simps(1) proj_stoch_proc_component(1)
proj_stoch_proc_component(2))
finally have "X i x = X i w" .
thus "x ∈ (X i) -`{X i w}" by simp
qed
thus "x ∈ (⋂i∈{m. m ≤ n}. (X i) -` {X i w})" by auto
qed
show "(⋂i∈{m. m ≤ n}. (X i) -` {X i w}) ⊆ (proj_stoch_proc X n) -` {proj_stoch_proc X n w}"
proof
fix x
assume "x∈ (⋂i∈{m. m ≤ n}. (X i) -` {X i w})"
hence "⋀i. i ∈{m. m ≤ n} ⟹ x ∈ (X i) -`{X i w}" by simp
hence "⋀i. i ∈{m. m ≤ n} ⟹ X i x = X i w" by simp
hence "⋀i. i ≤ n ⟹ X i x = X i w" by auto
hence "psX x = psX w" unfolding psX_def
by (metis (mono_tags, hide_lams) diff_streams_only_if linear not_le order_refl
proj_stoch_proc_component(1) proj_stoch_proc_component(2))
thus "x ∈ (proj_stoch_proc X n) -` {proj_stoch_proc X n w}" unfolding psX_def by auto
qed
qed
lemma (in infinite_cts_filtration) proj_stoch_singleton_set:
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n w} ∈ sets (F n)"
proof -
have "⋀i. i ≤ n ⟹ (X i) ∈ measurable (F n) borel"
by (meson adapt_stoch_proc_def assms increasing_measurable_info)
have "(⋂i∈ {m. m ≤ n}. (X i) -` {X i w}) ∈ sets (F n)"
proof ((rule sigma_algebra.countable_INT''), auto)
show "sigma_algebra (space (F n)) (sets (F n))"
using measure_space measure_space_def by auto
show "UNIV ∈ sets (F n)"
using ‹sigma_algebra (space (F n)) (sets (F n))› nat_filtration_space natural_filtration
sigma_algebra.sigma_sets_eq sigma_sets_top by fastforce
have "⋀i. i ≤ n ⟹ (X i) -` {X i w} ∈ sets (nat_filtration n)"
proof (rule nat_filtration_borel_measurable_singleton)
fix i
assume "i ≤ n"
show "X i ∈ borel_measurable (nat_filtration n)" using assms natural_filtration unfolding adapt_stoch_proc_def
using ‹i ≤ n› increasing_measurable_info by blast
qed
thus "⋀i. i ≤ n ⟹ (X i) -` {X i w} ∈ sets (F n)" using natural_filtration by simp
qed
thus ?thesis using assms by (simp add: proj_stoch_preimage)
qed
lemma (in infinite_cts_filtration) finite_range_stream_space:
fixes f::"'a ⇒ 'b::t1_space"
assumes "finite (range f)"
shows "(λw. snth w i) -` (open_exclude_set (f x) (range f)) ∈ sets (stream_space borel)"
proof -
define opex where "opex = open_exclude_set (f x) (range f)"
have "open opex" and "opex ∩ (range f) = {f x}" using assms unfolding opex_def by
(auto simp add:open_exclude_finite)
hence "opex∈ sets borel" by simp
hence vim: "(λw. snth w i) -` opex ∈ sets (vimage_algebra (streams (space borel)) (λw. snth w i) borel)"
by (metis in_vimage_algebra inf_top.right_neutral space_borel streams_UNIV)
have "(λw. snth w i) -` opex ∈ sets (⨆i. vimage_algebra (streams (space borel)) (λw. snth w i) borel)"
proof (rule in_sets_SUP, simp)
show "⋀i. i ∈ UNIV ⟹ space (vimage_algebra (streams (space borel)) (λw. w !! i) borel) =
UNIV" by simp
show "(λw. w !! i) -` opex ∈ sets (vimage_algebra (streams (space borel)) (λw. w !! i) borel)"
using vim by simp
qed
thus ?thesis using sets_stream_space_eq unfolding opex_def by blast
qed
lemma (in infinite_cts_filtration) proj_stoch_range_singleton:
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
and "r∈ range (proj_stoch_proc X n)"
shows "∃A∈sets (stream_space borel). range (proj_stoch_proc X n) ∩ A = {r}"
proof -
have "∃x. r = proj_stoch_proc X n x" using assms by auto
from this obtain x where "r = proj_stoch_proc X n x" by auto
have "⋀i. i ≤ n ⟹ (X i) ∈ measurable (F n) borel"
by (meson adapt_stoch_proc_def assms increasing_measurable_info)
hence fin: "⋀i. i ≤ n ⟹ finite (range (X i))"
by (metis bernoulli bernoulli_stream_space nat_filtration_vimage_finite natural_filtration streams_UNIV)
show ?thesis
proof
define cand where "cand = (⋂i ∈ {m. m≤ n}. (λw. snth w i) -` (open_exclude_set (X i x) (range (X i))))"
show "cand ∈ sets (stream_space borel)" unfolding cand_def
proof ((rule sigma_algebra.countable_INT''), auto)
show "UNIV ∈ sets (stream_space borel)" by (metis space_borel streams_UNIV streams_stream_space)
show "sigma_algebra (space (stream_space borel)) (sets (stream_space borel))"
by (simp add: sets.sigma_algebra_axioms)
show "⋀i. i ≤ n ⟹ (λw. w !! i) -` open_exclude_set (X i x) (range (X i)) ∈ sets (stream_space borel)"
proof -
fix i
assume "i ≤ n"
thus "(λw. w !! i) -` open_exclude_set (X i x) (range (X i)) ∈ sets (stream_space borel)"
using fin by (simp add:finite_range_stream_space)
qed
qed
have "range (proj_stoch_proc X n) ∩ cand = {proj_stoch_proc X n x}"
proof
have "proj_stoch_proc X n x ∈ range (proj_stoch_proc X n) ∩ cand"
proof
show "proj_stoch_proc X n x ∈ range (proj_stoch_proc X n)" by simp
show "proj_stoch_proc X n x ∈ cand" unfolding cand_def
proof
fix i
assume "i∈ {m. m≤ n}"
hence "i ≤ n" by simp
hence "snth (proj_stoch_proc X n x) i = X i x"
by (metis le_antisym not_less proj_stoch_proc_component)
also have "... ∈ open_exclude_set (X i x) (range (X i))" using assms open_exclude_finite(2)
by (metis IntE ‹i ≤ n› fin insert_iff rangeI)
finally have "snth (proj_stoch_proc X n x) i ∈ open_exclude_set (X i x) (range (X i))" .
thus "proj_stoch_proc X n x ∈ (λw. w !! i) -` open_exclude_set (X i x) (range (X i))" by simp
qed
qed
thus "{proj_stoch_proc X n x} ⊆ range (proj_stoch_proc X n) ∩ cand" by simp
show "range (proj_stoch_proc X n) ∩ cand ⊆ {proj_stoch_proc X n x}"
proof
fix z
assume "z∈ range (proj_stoch_proc X n) ∩ cand"
hence "∃y. z = proj_stoch_proc X n y" by auto
from this obtain y where "z = proj_stoch_proc X n y" by auto
hence "proj_stoch_proc X n y ∈ cand" using ‹z∈ range (proj_stoch_proc X n) ∩ cand› by simp
have "∀i. i≤n ⟶ X i y = X i x"
proof (intro allI impI)
fix i
assume "i ≤ n"
hence "X i y = snth (proj_stoch_proc X n y) i"
by (metis le_antisym not_less proj_stoch_proc_component)
also have "... ∈ open_exclude_set (X i x) (range (X i))"
using ‹proj_stoch_proc X n y ∈ cand› ‹i ≤ n› unfolding cand_def by simp
finally have "X i y ∈ open_exclude_set (X i x) (range (X i))" .
thus "X i y = X i x" using assms using assms open_exclude_finite(2)
by (metis Int_iff ‹i ≤ n› empty_iff fin insert_iff rangeI)
qed
hence "∀i. snth (proj_stoch_proc X n y) i = snth (proj_stoch_proc X n x) i"
using proj_stoch_proc_component by (metis nat_le_linear not_less)
hence "proj_stoch_proc X n y = proj_stoch_proc X n x"
using diff_streams_only_if by auto
thus "z∈ {proj_stoch_proc X n x}" using ‹z = proj_stoch_proc X n y› by auto
qed
qed
thus "range (proj_stoch_proc X n) ∩ cand = {r}" using ‹r = proj_stoch_proc X n x› by simp
qed
qed
definition (in infinite_cts_filtration) stream_space_single where
"stream_space_single X r = (if (∃U. U∈ sets (stream_space borel) ∧ U∩ (range X) = {r})
then SOME U. U∈ sets (stream_space borel) ∧ U ∩ (range X) = {r} else {})"
lemma (in infinite_cts_filtration) stream_space_singleI:
assumes "∃U. U∈ sets (stream_space borel) ∧ U∩ (range X) = {r}"
shows "stream_space_single X r ∈ sets (stream_space borel) ∧ stream_space_single X r ∩ (range X) = {r}"
proof -
let ?V = "SOME U. U∈ sets (stream_space borel) ∧ U∩ (range X) = {r}"
have vprop: "?V∈ sets (stream_space borel) ∧ ?V ∩ (range X) = {r}" using someI_ex[of "λU. U∈ sets (stream_space borel) ∧ U∩ (range X) = {r}"]
assms by blast
show ?thesis by (simp add:stream_space_single_def vprop assms)
qed
lemma (in infinite_cts_filtration)
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
and "r∈ range (proj_stoch_proc X n)"
shows stream_space_single_set: "stream_space_single (proj_stoch_proc X n) r ∈ sets (stream_space borel)"
and stream_space_single_preimage: "stream_space_single (proj_stoch_proc X n) r ∩ range (proj_stoch_proc X n) = {r}"
proof -
have "∃A∈sets (stream_space borel). range (proj_stoch_proc X n) ∩ A = {r}"
by (simp add: assms proj_stoch_range_singleton)
hence "∃U. U ∈ sets (stream_space borel) ∧ U ∩ range (proj_stoch_proc X n) = {r}" by auto
hence a: "stream_space_single (proj_stoch_proc X n) r ∈ sets (stream_space borel) ∧
stream_space_single (proj_stoch_proc X n) r ∩ (range (proj_stoch_proc X n)) = {r}"
using stream_space_singleI[of "proj_stoch_proc X n"] by simp
thus "stream_space_single (proj_stoch_proc X n) r ∈ sets (stream_space borel)" by simp
show "stream_space_single (proj_stoch_proc X n) r ∩ range (proj_stoch_proc X n) = {r}" using a by simp
qed
subsubsection ‹Induced filtration, relationship with filtration generated by underlying stochastic process›
definition comp_proj_i where
"comp_proj_i X n i y = {z∈ range (proj_stoch_proc X n). snth z i = y}"
lemma (in infinite_cts_filtration) comp_proj_i_finite:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
shows "finite (comp_proj_i X n i y)"
proof -
have "finite (range (proj_stoch_proc X n))"
using proj_stoch_set_finite_range[of X] assms by simp
thus ?thesis unfolding comp_proj_i_def by simp
qed
lemma stoch_proc_comp_proj_i_preimage:
assumes "i ≤ n"
shows "(X i) -` {X i x} = (⋃z∈ comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z})"
proof
show "X i -` {X i x} ⊆ (⋃z∈comp_proj_i X n i (X i x). proj_stoch_proc X n -` {z})"
proof
fix w
assume "w ∈ X i -` {X i x}"
hence "X i w = X i x" by simp
hence "snth (proj_stoch_proc X n w) i = X i x" using assms
by (metis le_neq_implies_less proj_stoch_proc_component(1) proj_stoch_proc_component(2))
hence "(proj_stoch_proc X n w) ∈ comp_proj_i X n i (X i x)" unfolding comp_proj_i_def by simp
moreover have "w∈ proj_stoch_proc X i -` {proj_stoch_proc X i w}" by simp
ultimately show "w∈ (⋃z∈comp_proj_i X n i (X i x). proj_stoch_proc X n -` {z})" by simp
qed
show "(⋃z∈comp_proj_i X n i (X i x). proj_stoch_proc X n -` {z}) ⊆ X i -` {X i x}"
proof -
have "∀z∈ comp_proj_i X n i (X i x). proj_stoch_proc X n -` {z} ⊆ X i -` {X i x}"
proof
fix z
assume "z∈ comp_proj_i X n i (X i x)"
hence "z∈ range (proj_stoch_proc X n)" and "snth z i = X i x" unfolding comp_proj_i_def by auto
show "proj_stoch_proc X n -` {z} ⊆ X i -` {X i x}"
proof
fix w
assume "w∈proj_stoch_proc X n -` {z}"
have "X i w = snth (proj_stoch_proc X n w) i" using assms
by (metis le_neq_implies_less proj_stoch_proc_component(1) proj_stoch_proc_component(2))
also have "... = snth z i" using ‹w∈proj_stoch_proc X n -` {z}› by auto
also have "... = X i x" using ‹snth z i = X i x› by simp
finally have "X i w = X i x" .
thus "w∈ X i -` {X i x}" by simp
qed
qed
thus ?thesis by auto
qed
qed
definition comp_proj where
"comp_proj X n y = {z∈ range (proj_stoch_proc X n). snth z n = y}"
lemma (in infinite_cts_filtration) comp_proj_finite:
fixes X::"nat ⇒ bool stream ⇒ 'b::{t0_space}"
assumes "borel_adapt_stoch_proc F X"
shows "finite (comp_proj X n y)"
proof -
have "finite (range (proj_stoch_proc X n))"
using proj_stoch_set_finite_range[of X] assms by simp
thus ?thesis unfolding comp_proj_def by simp
qed
lemma stoch_proc_comp_proj_preimage:
shows "(X n) -` {X n x} = (⋃z∈ comp_proj X n (X n x). (proj_stoch_proc X n) -` {z})"
proof
show "X n -` {X n x} ⊆ (⋃z∈comp_proj X n (X n x). proj_stoch_proc X n -` {z})"
proof
fix w
assume "w ∈ X n -` {X n x}"
hence "X n w = X n x" by simp
hence "snth (proj_stoch_proc X n w) n = X n x" by (simp add: proj_stoch_proc_component(2))
hence "(proj_stoch_proc X n w) ∈ comp_proj X n (X n x)" unfolding comp_proj_def by simp
moreover have "w∈ proj_stoch_proc X n -` {proj_stoch_proc X n w}" by simp
ultimately show "w∈ (⋃z∈comp_proj X n (X n x). proj_stoch_proc X n -` {z})" by simp
qed
show "(⋃z∈comp_proj X n (X n x). proj_stoch_proc X n -` {z}) ⊆ X n -` {X n x}"
proof -
have "∀z∈ comp_proj X n (X n x). proj_stoch_proc X n -` {z} ⊆ X n -` {X n x}"
proof
fix z
assume "z∈ comp_proj X n (X n x)"
hence "z∈ range (proj_stoch_proc X n)" and "snth z n = X n x" unfolding comp_proj_def by auto
show "proj_stoch_proc X n -` {z} ⊆ X n -` {X n x}"
proof
fix w
assume "w∈proj_stoch_proc X n -` {z}"
have "X n w = snth (proj_stoch_proc X n w) n" by (simp add: proj_stoch_proc_component(2))
also have "... = snth z n" using ‹w∈proj_stoch_proc X n -` {z}› by auto
also have "... = X n x" using ‹snth z n = X n x› by simp
finally have "X n w = X n x" .
thus "w∈ X n -` {X n x}" by simp
qed
qed
thus ?thesis by auto
qed
qed
lemma comp_proj_stoch_proc_preimage:
shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n x} = (⋂ i∈ {m. m≤n}. (X i) -`{X i x})"
proof
show "proj_stoch_proc X n -` {proj_stoch_proc X n x} ⊆ (⋂i∈{m. m ≤ n}. X i -` {X i x})"
proof
fix z
assume "z∈ proj_stoch_proc X n -` {proj_stoch_proc X n x}"
hence "proj_stoch_proc X n z = proj_stoch_proc X n x" by simp
hence "∀i≤n. X i z = X i x" using proj_stoch_proc_component by (metis less_le)
hence "∀i≤n. z∈ X i -`{X i x}" by simp
thus "z∈ (⋂i∈{m. m ≤ n}. X i -` {X i x})" by simp
qed
show "(⋂i∈{m. m ≤ n}. X i -` {X i x}) ⊆ proj_stoch_proc X n -` {proj_stoch_proc X n x}"
proof
fix z
assume "z∈ (⋂i∈{m. m ≤ n}. X i -` {X i x})"
hence "∀i≤ n. X i z = X i x" by auto
hence "∀i. snth (proj_stoch_proc X n z) i = snth (proj_stoch_proc X n x) i"
using proj_stoch_proc_component by (metis nat_le_linear not_less)
hence "proj_stoch_proc X n z = proj_stoch_proc X n x" using diff_streams_only_if by auto
thus "z∈ proj_stoch_proc X n -` {proj_stoch_proc X n x}" by simp
qed
qed
definition stoch_proc_filt where
"stoch_proc_filt M X N (n::nat) = gen_subalgebra M (sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets N }))"
lemma stoch_proc_filt_space:
shows "space (stoch_proc_filt M X N n) = space M" unfolding stoch_proc_filt_def by (simp add:gen_subalgebra_space)
lemma stoch_proc_filt_sets:
assumes "⋀i. i ≤ n⟹ (X i) ∈ measurable M N"
shows "sets (stoch_proc_filt M X N n) = (sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets N }))"
unfolding stoch_proc_filt_def
proof (rule gen_subalgebra_sigma_sets)
show "sigma_algebra (space M) (sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}))" using assms
by (simp add: adapt_sigma_sets)
show "sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}) ⊆ sets M"
proof (rule sigma_algebra.sigma_sets_subset, rule Sigma_Algebra.sets.sigma_algebra_axioms, rule UN_subset_iff[THEN iffD2], intro ballI)
fix i
assume "i∈ {m. m≤n}"
thus "{X i -` A ∩ space M |A. A ∈ sets N} ⊆ sets M" using assms measurable_sets by blast
qed
qed
lemma stoch_proc_filt_adapt:
assumes "⋀n. X n ∈ measurable M N"
shows "adapt_stoch_proc (stoch_proc_filt M X N) X N" unfolding adapt_stoch_proc_def
proof
fix m
show "X m ∈ measurable (stoch_proc_filt M X N m) N" unfolding measurable_def
proof ((intro CollectI), (intro conjI))
have "space (stoch_proc_filt M X N m) = space M" by (simp add: stoch_proc_filt_space)
thus "X m ∈ space (stoch_proc_filt M X N m) → space N" using assms unfolding measurable_def by simp
show "∀y∈sets N. X m -` y ∩ space (stoch_proc_filt M X N m) ∈ sets (stoch_proc_filt M X N m)"
proof
fix B
assume "B∈ sets N"
have "X m -` B ∩ space (stoch_proc_filt M X N m) = X m -`B ∩ space M"
using ‹space (stoch_proc_filt M X N m) = space M› by simp
also have "... ∈ (⋃ i∈ {p. p≤ m}. {(X i -`A) ∩ (space M) | A. A∈ sets N })" using ‹B∈ sets N› by auto
also have "... ⊆ sigma_sets (space M) (⋃ i∈ {p. p≤ m}. {(X i -`A) ∩ (space M) | A. A∈ sets N })" by auto
also have "... = sets (stoch_proc_filt M X N m)" using assms stoch_proc_filt_sets by blast
finally show "X m -` B ∩ space (stoch_proc_filt M X N m) ∈ sets (stoch_proc_filt M X N m)" .
qed
qed
qed
lemma stoch_proc_filt_disc_filtr:
assumes "⋀i. (X i) ∈ measurable M N"
shows "disc_filtr M (stoch_proc_filt M X N)" unfolding disc_filtr_def
proof (intro conjI allI impI)
{
fix n
show "subalgebra M (stoch_proc_filt M X N n)" unfolding subalgebra_def
proof
show "space (stoch_proc_filt M X N n) = space M" by (simp add:stoch_proc_filt_space)
show "sets (stoch_proc_filt M X N n) ⊆ sets M"
proof -
have "sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}) ⊆ sets M"
proof (rule sigma_algebra.sigma_sets_subset, rule Sigma_Algebra.sets.sigma_algebra_axioms, rule UN_subset_iff[THEN iffD2], intro ballI)
fix i
assume "i∈ {m. m≤n}"
thus "{X i -` A ∩ space M |A. A ∈ sets N} ⊆ sets M" using assms measurable_sets by blast
qed
thus ?thesis using assms by (simp add:stoch_proc_filt_sets)
qed
qed
}
{
fix n
fix p
assume "(n::nat) ≤ p"
show "subalgebra (stoch_proc_filt M X N p) (stoch_proc_filt M X N n)" unfolding subalgebra_def
proof
have "space (stoch_proc_filt M X N n) = space M" by (simp add: stoch_proc_filt_space)
also have "... = space (stoch_proc_filt M X N p)" by (simp add: stoch_proc_filt_space)
finally show "space (stoch_proc_filt M X N n) = space (stoch_proc_filt M X N p)" .
show "sets (stoch_proc_filt M X N n) ⊆ sets (stoch_proc_filt M X N p)"
proof -
have "sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}) ⊆
sigma_sets (space M) (⋃i∈{m. m ≤ p}. {X i -` A ∩ space M |A. A ∈ sets N})"
proof (rule sigma_sets_mono')
show "(⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N}) ⊆ (⋃i∈{m. m ≤ p}. {X i -` A ∩ space M |A. A ∈ sets N})"
proof (rule UN_subset_iff[THEN iffD2], intro ballI)
fix i
assume "i∈ {m. m≤n}"
show "{X i -` A ∩ space M |A. A ∈ sets N} ⊆ (⋃i∈{m. m ≤ p}. {X i -` A ∩ space M |A. A ∈ sets N})"
using ‹i ∈ {m. m ≤ n}› ‹n ≤ p› order_trans by auto
qed
qed
thus ?thesis using assms by (simp add:stoch_proc_filt_sets)
qed
qed
}
qed
lemma gen_subalgebra_eq_space_sets:
assumes "space M = space N"
and "P = Q"
and "P⊆ Pow (space M)"
shows "sets (gen_subalgebra M P) = sets (gen_subalgebra N Q)" unfolding gen_subalgebra_def using assms by simp
lemma stoch_proc_filt_eq_sets:
assumes "space M = space N"
shows "sets (stoch_proc_filt M X P n) = sets (stoch_proc_filt N X P n)" unfolding stoch_proc_filt_def
proof (rule gen_subalgebra_eq_space_sets, (simp add: assms)+)
show "sigma_sets (space N) (⋃x∈{m. m ≤ n}. {X x -` A ∩ space N |A. A ∈ sets P}) ⊆ Pow (space N)"
proof (rule sigma_algebra.sigma_sets_subset)
show "sigma_algebra (space N) (Pow (space N))" by (simp add: sigma_algebra_Pow)
show "(⋃x∈{m. m ≤ n}. {X x -` A ∩ space N |A. A ∈ sets P}) ⊆ Pow (space N)" by auto
qed
qed
lemma (in infinite_cts_filtration) stoch_proc_filt_triv_init:
fixes X::"nat ⇒ bool stream ⇒ real"
assumes "borel_adapt_stoch_proc nat_filtration X"
shows "init_triv_filt M (stoch_proc_filt M X borel)" unfolding init_triv_filt_def
proof
show "filtration M (stoch_proc_filt M X borel)" using stoch_proc_filt_disc_filtr unfolding filtration_def
by (metis adapt_stoch_proc_def assms disc_filtr_def measurable_from_subalg nat_filtration_subalgebra)
show "sets (stoch_proc_filt M X borel bot) = {{}, space M}"
proof -
have seteq: "sets (stoch_proc_filt M X borel 0) =
(sigma_sets (space M) (⋃ i∈ {m. m≤ 0}. {(X i -`A) ∩ (space M) | A. A∈ sets borel}))"
proof (rule stoch_proc_filt_sets)
show "⋀i. i ≤ 0 ⟹ random_variable borel (X i)"
proof -
fix i::nat
assume "i ≤ 0"
show "random_variable borel (X i)" using assms unfolding adapt_stoch_proc_def
using filtration_measurable nat_discrete_filtration
using natural_filtration by blast
qed
qed
have "triv_init_disc_filtr_prob_space M nat_filtration"
proof (unfold_locales, intro conjI)
show "disc_filtr M nat_filtration" unfolding disc_filtr_def
using filtrationE2 nat_discrete_filtration nat_filtration_subalgebra by auto
show "sets (nat_filtration ⊥) = {{}, space M}" using nat_info_filtration unfolding init_triv_filt_def by simp
qed
hence "∃c. ∀w ∈ space M. ((X 0 w)::real) = c" using assms
triv_init_disc_filtr_prob_space.adapted_init[of M nat_filtration X] by simp
from this obtain c where img: "∀w ∈ space M. (X 0 w) = c" by auto
have "(⋃ i∈ {m. m≤ 0}. {(X i -`A) ∩ (space M) | A. A∈ sets borel}) =
{(X 0 -`A) ∩ (space M) | A. A∈ sets borel}" by auto
also have "... = {{}, space M}"
proof
show "{X 0 -` A ∩ space M |A. A ∈ sets borel} ⊆ {{}, space M}"
proof -
have "∀A ∈ sets borel. (X 0 -`A) ∩ (space M) ∈ {{}, space M}"
proof
fix A::"real set"
assume "A∈ sets borel"
show "(X 0 -`A) ∩ (space M) ∈ {{}, space M}"
proof (cases "c∈ A")
case True
hence "X 0 -` A ∩ space M = space M" using img by auto
thus ?thesis by simp
next
case False
hence "X 0 -` A ∩ space M = {}" using img by auto
thus ?thesis by simp
qed
qed
thus ?thesis by auto
qed
show "{{}, space M} ⊆ {X 0 -` A ∩ space M |A. A ∈ sets borel}"
proof -
have "{} ∈ {X 0 -` A ∩ space M |A. A ∈ sets borel}" by blast
moreover have "space M ∈ {X 0 -` A ∩ space M |A. A ∈ sets borel}"
proof -
have "UNIV ⊆ X 0 -` space borel"
using space_borel by blast
then show ?thesis
using bernoulli_stream_space by blast
qed
ultimately show ?thesis by auto
qed
qed
finally have "(⋃ i∈ {m. m≤ 0}. {(X i -`A) ∩ (space M) | A. A∈ sets borel}) = {{}, space M}" .
moreover have "sigma_sets (space M) {{}, space M} = {{}, space M}"
proof -
have "sigma_sets (space M) {space M} = {{}, space M}" by simp
have "sigma_sets (space M) (sigma_sets (space M) {space M}) = sigma_sets (space M) {space M}"
by (rule sigma_sets_sigma_sets_eq, simp)
also have "... = {{}, space M}" by simp
finally show ?thesis by simp
qed
ultimately show ?thesis using seteq by (simp add: bot_nat_def)
qed
qed
lemma (in infinite_cts_filtration) stream_space_borel_union:
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
and "i≤ n"
and "A∈ sets borel"
shows "∀y∈ A∩ range (X i). X i -`{y} = (proj_stoch_proc X n) -` (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z))"
proof
fix y
assume "y∈ A∩ range (X i)"
hence "∃x. y = X i x" by auto
from this obtain x where "y = X i x" by auto
hence "X i -`{y} = X i -`{X i x}" by simp
also have "... = (⋃z∈ comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z})"
using ‹i≤ n› by (simp add: stoch_proc_comp_proj_i_preimage)
also have "... = (⋃z∈ comp_proj_i X n i (X i x). (proj_stoch_proc X n) -`
(stream_space_single (proj_stoch_proc X n) z))"
proof -
have "∀z∈ comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z} = (proj_stoch_proc X n) -`
(stream_space_single (proj_stoch_proc X n) z)"
proof
fix z
assume "z ∈ comp_proj_i X n i (X i x)"
have "stream_space_single (proj_stoch_proc X n) z ∩ range (proj_stoch_proc X n) = {z}"
using stream_space_single_preimage assms
proof -
have "z ∈ range (proj_stoch_proc X n)"
using ‹z ∈ comp_proj_i X n i (X i x)› comp_proj_i_def by force
then show ?thesis
by (meson assms stream_space_single_preimage)
qed
thus "(proj_stoch_proc X n) -` {z} = (proj_stoch_proc X n) -`
(stream_space_single (proj_stoch_proc X n) z)" by auto
qed
thus ?thesis by auto
qed
also have "... = proj_stoch_proc X n -` (⋃z∈ comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z))"
by (simp add: ‹y = X i x› vimage_Union)
finally show "X i -`{y} = (proj_stoch_proc X n) -` (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z))" using ‹y = X i x› by simp
qed
lemma (in infinite_cts_filtration) proj_stoch_pre_borel:
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
shows "proj_stoch_proc X n -` {proj_stoch_proc X n x} ∈ sets (stoch_proc_filt M X borel n)"
proof -
have "proj_stoch_proc X n -` {proj_stoch_proc X n x} = (⋂ i∈ {m. m≤n}. (X i) -`{X i x})"
by (simp add:comp_proj_stoch_proc_preimage)
also have "... ∈ sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})"
proof -
have inset: "∀i≤n. (X i) -`{X i x} ∈ {X i -` A ∩ space M |A. A ∈ sets borel}"
proof (intro allI impI)
fix i
assume "i ≤ n"
have "∃U. open U ∧ U∩ (range (X i)) = {X i x}"
proof -
have "∃U. open U ∧ X i x∈ U ∧ U∩ ((range (X i))-{X i x}) = {}"
proof (rule open_except_set)
have "finite (range (X i))" using assms
by (metis adapt_stoch_proc_def bernoulli bernoulli_stream_space
nat_filtration_vimage_finite natural_filtration streams_UNIV)
thus "finite (range (X i) -{X i x})" by auto
show "X i x∉ (range (X i)) -{X i x}" by simp
qed
thus ?thesis using assms by auto
qed
from this obtain U where "open U" and "U∩ (range (X i)) = {X i x}" by auto
have "X i -` {X i x} = X i -`U" using ‹U∩ (range (X i)) = {X i x}› by auto
also have "... = X i -` U ∩ space M" using bernoulli bernoulli_stream_space by simp
finally have "X i -` {X i x} = X i -` U ∩ space M" .
moreover have "U ∈ sets borel" using ‹open U› by simp
ultimately show "(X i) -`{X i x} ∈ {X i -` A ∩ space M |A. A ∈ sets borel}" by auto
qed
show ?thesis
proof (rule sigma_set_inter_init)
show "(⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel}) ⊆ Pow (space M)" by auto
show "⋀i. i ≤ n ⟹ X i -` {X i x} ∈ sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})"
using inset by (metis (no_types, lifting) UN_I mem_Collect_eq sigma_sets.Basic)
qed
qed
also have "... = sets (stoch_proc_filt M X borel n)"
proof (rule stoch_proc_filt_sets[symmetric])
fix i
assume "i ≤ n"
show "random_variable borel (X i)" using assms borel_adapt_stoch_proc_borel_measurable by blast
qed
finally show "proj_stoch_proc X n -` {proj_stoch_proc X n x}
∈ sets (stoch_proc_filt M X borel n)" .
qed
lemma (in infinite_cts_filtration) stoch_proc_filt_gen:
fixes X::"nat ⇒ bool stream ⇒ ('b::t2_space)"
assumes "borel_adapt_stoch_proc F X"
shows "stoch_proc_filt M X borel n = fct_gen_subalgebra M (stream_space borel) (proj_stoch_proc X n)"
proof -
have "(⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})
⊆ {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}"
proof (rule UN_subset_iff[THEN iffD2], intro ballI)
fix i
assume "i∈ {m. m≤n}"
hence "i ≤ n" by simp
show "{X i -` A ∩ space M |A. A ∈ sets borel} ⊆
{proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}"
proof -
have "⋀A. A∈ sets borel ⟹ X i -` A ∩ space M ∈ {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}"
proof -
fix A::"'b set"
assume "A∈ sets borel"
have "X i -`A ∩ space M = X i -` A" using bernoulli bernoulli_stream_space by simp
also have "... = X i -`(A∩ range (X i))" by auto
also have "... = (⋃ y∈ A∩ range (X i). X i -`{y})" by auto
also have "... = (⋃ y∈ A∩ range (X i). (proj_stoch_proc X n) -` (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z)))" using stream_space_borel_union assms ‹i≤n› ‹A∈sets borel›
by (metis (mono_tags, lifting) image_cong)
also have "... = (proj_stoch_proc X n) -` (⋃ y∈ A∩ range (X i). (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z)))" by (simp add: vimage_Union)
finally have "X i -`A ∩ space M = (proj_stoch_proc X n) -` (⋃ y∈ A∩ range (X i). (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z)))" .
moreover have "(⋃ y∈ A∩ range (X i). (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z))) ∈ sets (stream_space borel)"
proof -
have "finite (A∩ range (X i))"
proof -
have "finite (range (X i))" using assms
by (metis adapt_stoch_proc_def bernoulli bernoulli_stream_space
nat_filtration_vimage_finite natural_filtration streams_UNIV)
thus ?thesis by auto
qed
moreover have "∀y∈ A∩ range (X i). (⋃z∈ comp_proj_i X n i y.
(stream_space_single (proj_stoch_proc X n) z)) ∈ sets (stream_space borel)"
proof
fix y
assume "y∈ A∩ range (X i)"
have "finite (comp_proj_i X n i y)" by (simp add: assms comp_proj_i_finite)
moreover have "∀z∈ comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z) ∈ sets (stream_space borel)"
proof
fix z
assume "z∈ comp_proj_i X n i y"
thus "(stream_space_single (proj_stoch_proc X n) z) ∈ sets (stream_space borel)" using assms
stream_space_single_set unfolding comp_proj_i_def by auto
qed
ultimately show "(⋃z∈ comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z)) ∈
sets (stream_space borel)" by blast
qed
ultimately show ?thesis by blast
qed
ultimately show "X i -` A ∩ space M ∈ {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}"
by (metis (mono_tags, lifting) ‹X i -` A ∩ space M = X i -` A› mem_Collect_eq)
qed
thus ?thesis by auto
qed
qed
hence l: "sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel}) ⊆
sigma_sets (space M) {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}"
by (rule sigma_sets_mono')
have "{proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}
⊆ sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})"
proof -
have "∀B∈ sets (stream_space borel). proj_stoch_proc X n -` B ∩ space M ∈
sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel })"
proof
fix B::"'b stream set"
assume "B∈ sets (stream_space borel)"
have "proj_stoch_proc X n -` B ∩ space M = proj_stoch_proc X n -`B" using bernoulli bernoulli_stream_space by simp
also have "... = proj_stoch_proc X n -` (B ∩ range (proj_stoch_proc X n))" by auto
also have "... = proj_stoch_proc X n -` (⋃ y∈ (B ∩ range (proj_stoch_proc X n)). {y})" by simp
also have "... = (⋃ y∈ (B ∩ range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y})" by auto
finally have eqB: "proj_stoch_proc X n -` B ∩ space M =
(⋃ y∈ (B ∩ range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y})" .
have "∀y∈ (B ∩ range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y} ∈
sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel })"
proof
fix y
assume "y ∈ B ∩ range (proj_stoch_proc X n)"
hence "∃x. y = proj_stoch_proc X n x" by auto
from this obtain x where "y = proj_stoch_proc X n x" by auto
have "proj_stoch_proc X n -`{proj_stoch_proc X n x} ∈ sets (stoch_proc_filt M X borel n)"
by (rule proj_stoch_pre_borel, simp add:assms)
also have "... = sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel })"
proof (rule stoch_proc_filt_sets)
fix i
assume "i≤ n"
show "random_variable borel (X i)" using assms borel_adapt_stoch_proc_borel_measurable by blast
qed
finally show "proj_stoch_proc X n -`{y} ∈
sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel })"
using ‹y = proj_stoch_proc X n x› by simp
qed
hence "(⋃ y∈ (B ∩ range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y}) ∈
sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel })"
proof (rule sigma_set_union_count)
have "finite (range (proj_stoch_proc X n))"
by (simp add: assms proj_stoch_set_finite_range)
thus "countable (B ∩ range (proj_stoch_proc X n))"
by (simp add: countable_finite)
qed
thus "proj_stoch_proc X n -` B ∩ space M ∈
sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})" using eqB by simp
qed
thus ?thesis by auto
qed
hence "sigma_sets (space M) {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}
⊆ sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})" by (rule sigma_sets_mono)
hence "sigma_sets (space M) {proj_stoch_proc X n -` B ∩ space M |B. B ∈ sets (stream_space borel)}
= sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel})" using l by simp
thus ?thesis unfolding stoch_proc_filt_def fct_gen_subalgebra_def by simp
qed
lemma (in infinite_coin_toss_space) stoch_proc_subalg_nat_filt:
assumes "borel_adapt_stoch_proc nat_filtration X"
shows "subalgebra (nat_filtration n) (stoch_proc_filt M X borel n)" unfolding subalgebra_def
proof
show "space (stoch_proc_filt M X borel n) = space (nat_filtration n)"
by (simp add: fct_gen_subalgebra_space nat_filtration_def stoch_proc_filt_space)
show "sets (stoch_proc_filt M X borel n) ⊆ sets (nat_filtration n)"
proof -
have "∀i ≤ n. (∀ A∈ sets borel. X i -`A ∩ space M ∈ sets (nat_filtration n))"
proof (intro allI impI)
fix i
assume "i ≤ n"
have "X i ∈ borel_measurable (nat_filtration n)"
by (metis ‹i ≤ n› adapt_stoch_proc_def assms filtrationE2 measurable_from_subalg nat_discrete_filtration)
show "∀A∈sets borel. X i -` A ∩ space M ∈ sets (nat_filtration n)"
proof
fix A::"'a set"
assume "A∈ sets borel"
thus "X i -` A ∩ space M ∈ sets (nat_filtration n)" using ‹X i ∈ borel_measurable (nat_filtration n)›
by (metis bernoulli bernoulli_stream_space measurable_sets nat_filtration_space streams_UNIV)
qed
qed
hence "(⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel }) ⊆ sets (nat_filtration n)" by auto
hence "sigma_sets (space M) (⋃ i∈ {m. m≤ n}. {(X i -`A) ∩ (space M) | A. A∈ sets borel }) ⊆ sets (nat_filtration n)"
by (metis (no_types, lifting) bernoulli bernoulli_stream_space nat_filtration_space sets.sigma_sets_subset streams_UNIV)
thus ?thesis using assms stoch_proc_filt_sets unfolding adapt_stoch_proc_def
proof -
assume "∀t. X t ∈ borel_measurable (nat_filtration t)"
then have f1: "∀n m. X n ∈ borel_measurable m ∨ ¬ subalgebra m (nat_filtration n)"
by (meson measurable_from_subalg)
have "∀n. subalgebra M (nat_filtration n)"
by (metis infinite_coin_toss_space.nat_filtration_subalgebra infinite_coin_toss_space_axioms)
then show ?thesis
using f1 ‹⋀n X N M. (⋀i. i ≤ n ⟹ X i ∈ M →⇩M N) ⟹ sets (stoch_proc_filt M X N n) = sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets N})› ‹sigma_sets (space M) (⋃i∈{m. m ≤ n}. {X i -` A ∩ space M |A. A ∈ sets borel}) ⊆ sets (nat_filtration n)› by blast
qed
qed
qed
lemma (in infinite_coin_toss_space)
assumes "N = bernoulli_stream q"
and "0 ≤ q"
and "q ≤ 1"
and "0 < p"
and "p < 1"
and "filt_equiv nat_filtration M N"
shows filt_equiv_sgt: "0 < q" and filt_equiv_slt: "q < 1"
proof -
have "space M = space N" using assms filt_equiv_space by simp
have eqs: "{w∈ space M. (snth w 0)} = pseudo_proj_True (Suc 0) -`{True ##sconst True}"
proof
show "{w ∈ space M. w !! 0} ⊆ pseudo_proj_True (Suc 0) -` {True ##sconst True}"
proof
fix w
assume "w ∈ {w ∈ space M. w !! 0}"
hence "snth w 0" by simp
hence "pseudo_proj_True (Suc 0) w = True##sconst True" by (simp add: pseudo_proj_True_def)
thus "w ∈ pseudo_proj_True (Suc 0) -` {True##sconst True}" by simp
qed
show "pseudo_proj_True (Suc 0) -` {True##sconst True} ⊆ {w ∈ space M. w !! 0}"
proof
fix w
assume "w ∈ pseudo_proj_True (Suc 0) -` {True##sconst True}"
hence "pseudo_proj_True (Suc 0) w = True##sconst True" by simp
hence "snth w 0"
by (metis pseudo_proj_True_Suc_prefix stream_eq_Stream_iff)
thus "w∈ {w ∈ space M. w !! 0}" using bernoulli bernoulli_stream_space by simp
qed
qed
hence natset: "{w∈ space M. (snth w 0)} ∈ sets (nat_filtration (Suc 0))"
proof -
have "pseudo_proj_True (Suc 0) -` {True##sconst True} ∈ sets (nat_filtration (Suc 0))"
proof (rule nat_filtration_singleton)
show "pseudo_proj_True (Suc 0) (True##sconst True) = True## sconst True" unfolding pseudo_proj_True_def by simp
qed
thus ?thesis using eqs by simp
qed
have eqf: "{w∈ space M. ¬(snth w 0)} = pseudo_proj_True (Suc 0) -`{False ##sconst True}"
proof
show "{w ∈ space M. ¬(snth w 0)} ⊆ pseudo_proj_True (Suc 0) -` {False ##sconst True}"
proof
fix w
assume "w ∈ {w ∈ space M. ¬(snth w 0)}"
hence "¬(snth w 0)" by simp
hence "pseudo_proj_True (Suc 0) w = False ##sconst True"
by (simp add: pseudo_proj_True_def)
thus "w ∈ pseudo_proj_True (Suc 0) -` {False ## sconst True}" by simp
qed
show "pseudo_proj_True (Suc 0) -` {False ## sconst True} ⊆ {w ∈ space M. ¬(snth w 0)}"
proof
fix w
assume "w ∈ pseudo_proj_True (Suc 0) -` {False##sconst True}"
hence "pseudo_proj_True (Suc 0) w = False##sconst True" by simp
hence "¬(snth w 0)"
by (metis pseudo_proj_True_Suc_prefix stream_eq_Stream_iff)
thus "w∈ {w ∈ space M. ¬(snth w 0)}" using bernoulli bernoulli_stream_space by simp
qed
qed
hence natsetf: "{w∈ space M. ¬(snth w 0)} ∈ sets (nat_filtration (Suc 0))"
proof -
have "pseudo_proj_True (Suc 0) -` {False##sconst True} ∈ sets (nat_filtration (Suc 0))"
proof (rule nat_filtration_singleton)
show "pseudo_proj_True (Suc 0) (False##sconst True) = False##sconst True" unfolding pseudo_proj_True_def by simp
qed
thus ?thesis using eqf by simp
qed
show "0 < q"
proof (rule ccontr)
assume "¬ 0 < q"
hence "q = 0" using assms by simp
hence "emeasure N {w∈ space N. (snth w 0)} = q" using bernoulli_stream_component_probability[of N q]
assms by blast
hence "emeasure N {w∈ space N. (snth w 0)} = 0" using ‹q = 0› by simp
hence "emeasure M {w∈ space M. (snth w 0)} = 0" using assms natset unfolding filt_equiv_def
by (simp add: ‹space M = space N›)
moreover have "emeasure M {w∈ space M. (snth w 0)} = p" using bernoulli_stream_component_probability[of M p] bernoulli
p_lt_1 p_gt_0 by blast
ultimately show False using assms by simp
qed
show "q < 1"
proof (rule ccontr)
assume "¬ q < 1"
hence "q = 1" using assms by simp
hence "emeasure N {w∈ space N. ¬(snth w 0)} = 1 -q" using bernoulli_stream_component_probability_compl[of N q]
assms by blast
hence "emeasure N {w∈ space N. ¬(snth w 0)} = 0" using ‹q = 1› by simp
hence "emeasure M {w∈ space M. ¬(snth w 0)} = 0" using assms natsetf unfolding filt_equiv_def
by (simp add: ‹space M = space N›)
moreover have "emeasure M {w∈ space M. ¬(snth w 0)} = 1-p" using bernoulli_stream_component_probability_compl[of M p] bernoulli
p_lt_1 p_gt_0 by blast
ultimately show False using assms by simp
qed
qed
lemma stoch_proc_filt_filt_equiv:
assumes "filt_equiv F M N"
shows "stoch_proc_filt M f P n = stoch_proc_filt N f P n" using assms filt_equiv_space filt_equiv_sets
unfolding stoch_proc_filt_def
proof -
have "space N = space M"
by (metis assms filt_equiv_space)
then show "gen_subalgebra M (sigma_sets (space M) (⋃n∈{na. na ≤ n}. {f n -` C ∩ space M |C. C ∈ sets P})) =
gen_subalgebra N (sigma_sets (space N) (⋃n∈{na. na ≤ n}. {f n -` C ∩ space N |C. C ∈ sets P}))"
by (simp add: gen_subalgebra_def)
qed
lemma filt_equiv_filt:
assumes "filt_equiv F M N"
and "filtration M G"
shows "filtration N G" unfolding filtration_def
proof (intro allI conjI impI)
{
fix t
show "subalgebra N (G t)" using assms unfolding filtration_def filt_equiv_def
by (metis sets_eq_imp_space_eq subalgebra_def)
}
{
fix s::'c
fix t
assume "s ≤ t"
thus "subalgebra (G t) (G s)" using assms unfolding filtration_def by simp
}
qed
lemma filt_equiv_borel_AE_eq_iff:
fixes f::"'a⇒ real"
assumes "filt_equiv F M N"
and "f∈ borel_measurable (F t)"
and "g∈ borel_measurable (F t)"
and "prob_space N"
and "prob_space M"
shows "(AE w in M. f w = g w) ⟷ (AE w in N. f w = g w)"
proof -
{
assume fst: "AE w in M. f w = g w"
have set0: "{w∈ space M. f w ≠ g w} ∈ sets (F t) ∧ emeasure M {w∈ space M. f w ≠ g w} = 0"
proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
show "filtrated_prob_space M F" using assms unfolding filt_equiv_def
by (simp add: filtrated_prob_space_axioms.intro filtrated_prob_space_def)
show "AE w in M. f w = g w" using fst .
qed
hence "emeasure N {w∈ space M. f w ≠ g w} = 0" using assms unfolding filt_equiv_def by auto
moreover have "{w∈ space M. f w ≠ g w} ∈ sets N" using set0 assms unfolding filt_equiv_def
filtration_def subalgebra_def by auto
ultimately have "AE w in N. f w = g w"
proof -
have "space M = space N"
by (metis assms(1) filt_equiv_space)
then have "∀p. almost_everywhere N p ∨ {a ∈ space N. ¬ p a} ≠ {a ∈ space N. f a ≠ g a}"
using AE_iff_measurable ‹emeasure N {w ∈ space M. f w ≠ g w} = 0› ‹{w ∈ space M. f w ≠ g w} ∈ sets N›
by auto
then show ?thesis
by metis
qed
} note a = this
{
assume scd: "AE w in N. f w = g w"
have "space M = space N"
by (metis assms(1) filt_equiv_space)
have set0: "{w∈ space N. f w ≠ g w} ∈ sets (F t) ∧ emeasure N {w∈ space N. f w ≠ g w} = 0"
proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
show "filtrated_prob_space N F" using assms unfolding filt_equiv_def
by (metis ‹prob_space N› assms(1) filt_equiv_filtration filtrated_prob_space_axioms.intro filtrated_prob_space_def)
show "AE w in N. f w = g w" using scd .
qed
hence "emeasure M {w∈ space M. f w ≠ g w} = 0" using assms unfolding filt_equiv_def
by (metis (full_types) assms(1) filt_equiv_space)
moreover have "{w∈ space M. f w ≠ g w} ∈ sets M" using set0 assms unfolding filt_equiv_def
filtration_def subalgebra_def
by (metis (mono_tags) ‹space M = space N› contra_subsetD)
ultimately have "AE w in M. f w= g w"
proof -
have "∀p. almost_everywhere M p ∨ {a ∈ space M. ¬ p a} ≠ {a ∈ space M. f a ≠ g a}"
using AE_iff_measurable ‹emeasure M {w ∈ space M. f w ≠ g w} = 0› ‹{w ∈ space M. f w ≠ g w} ∈ sets M›
by auto
then show ?thesis
by metis
qed
}
thus ?thesis using a by auto
qed
lemma (in infinite_coin_toss_space) filt_equiv_triv_init:
assumes "filt_equiv F M N"
and "init_triv_filt M G"
shows "init_triv_filt N G" unfolding init_triv_filt_def
proof
show "filtration N G" using assms filt_equiv_filt[of F M N G] unfolding init_triv_filt_def by simp
show "sets (G ⊥) = {{}, space N}" using assms filt_equiv_space[of F M N] unfolding init_triv_filt_def by simp
qed
lemma (in infinite_coin_toss_space) fct_gen_subalgebra_meas_info:
assumes "∀w. f (g w) = f w"
and "f ∈ space M → space N"
and "g ∈ space M → space M"
shows "g ∈ measurable (fct_gen_subalgebra M N f) (fct_gen_subalgebra M N f)" unfolding measurable_def
proof (intro CollectI conjI)
show "g ∈ space (fct_gen_subalgebra M N f) → space (fct_gen_subalgebra M N f)" using assms
by (simp add: fct_gen_subalgebra_space)
show "∀y∈sets (fct_gen_subalgebra M N f). g -` y ∩ space (fct_gen_subalgebra M N f) ∈ sets (fct_gen_subalgebra M N f)"
proof
fix B
assume "B∈ sets (fct_gen_subalgebra M N f)"
hence "B ∈ {f -` B ∩ space M |B. B ∈ sets N}" using assms by (simp add:fct_gen_subalgebra_sigma_sets)
from this obtain C where "C∈ sets N" and "B = f -`C ∩ space M" by auto note Cprops = this
have "g -` B ∩ space (fct_gen_subalgebra M N f) = g -` B ∩ space M" using assms
by (simp add: fct_gen_subalgebra_space)
also have "... = g -` (f -` C ∩ space M) ∩ space M" using Cprops by simp
also have "... = g -` (f -` C)" using bernoulli bernoulli_stream_space by simp
also have "... = (f∘ g) -` C" by auto
also have "... = f -` C"
proof
show "(f ∘ g) -` C ⊆ f -` C"
proof
fix w
assume "w ∈ (f ∘ g) -` C"
hence "f (g w) ∈ C" by simp
hence "f w ∈ C" using assms by simp
thus "w∈ f -`C" by simp
qed
show "f -` C ⊆ (f ∘ g) -` C"
proof
fix w
assume "w∈ f -`C"
hence "f w ∈ C" by simp
hence "f (g w) ∈ C" using assms by simp
thus "w∈ (f ∘ g) -` C" by simp
qed
qed
also have "... ∈ sets (fct_gen_subalgebra M N f)"
using Cprops(2) ‹B ∈ sets (fct_gen_subalgebra M N f)› bernoulli bernoulli_stream_space
inf_top.right_neutral by auto
finally show "g -` B ∩ space (fct_gen_subalgebra M N f) ∈ sets (fct_gen_subalgebra M N f)" .
qed
qed
end
Theory Geometric_Random_Walk
theory Geometric_Random_Walk imports Infinite_Coin_Toss_Space
begin
section ‹Geometric random walk›
text ‹A geometric random walk is a stochastic process that can, at each time, move upwards or downwards,
depending on the outcome of a coin toss.›
fun (in infinite_coin_toss_space) geom_rand_walk:: "real ⇒ real ⇒ real ⇒ (nat ⇒ bool stream ⇒ real)" where
base: "(geom_rand_walk u d v) 0 = (λw. v)"|
step: "(geom_rand_walk u d v) (Suc n) = (λw. ((λTrue ⇒ u | False ⇒ d) (snth w n)) * (geom_rand_walk u d v) n w)"
locale prob_grw = infinite_coin_toss_space +
fixes geom_proc::"nat ⇒ bool stream ⇒ real" and u::real and d::real and init::real
assumes geometric_process:"geom_proc = geom_rand_walk u d init"
lemma (in prob_grw) geom_rand_walk_borel_measurable:
shows "(geom_proc n) ∈ borel_measurable M"
proof (induct n)
case (Suc n)
thus "geom_proc (Suc n) ∈ borel_measurable M"
proof -
have "geom_rand_walk u d init n ∈ borel_measurable M" using Suc geometric_process by simp
moreover have "(λw. ((λTrue ⇒ u | False ⇒ d) (snth w n))) ∈ borel_measurable M"
proof -
have "(λw. snth w n) ∈ measurable M (measure_pmf (bernoulli_pmf p))" by (simp add: bernoulli measurable_snth_count_space)
moreover have "(λTrue ⇒ u | False ⇒ d) ∈ borel_measurable (measure_pmf (bernoulli_pmf p))" by simp
ultimately show ?thesis by (simp add: measurable_comp)
qed
ultimately show ?thesis by (simp add:borel_measurable_times geometric_process)
qed
next
show "random_variable borel (geom_proc 0)" using geometric_process by simp
qed
lemma (in prob_grw) geom_rand_walk_pseudo_proj_True:
shows "geom_proc n = geom_proc n ∘ pseudo_proj_True n"
proof (induct n)
case (Suc n)
let ?tf = "(λTrue ⇒ u | False ⇒ d)"
{
fix w
have "geom_proc (Suc n) w = ?tf (snth w n) * geom_proc n w"
using geom_rand_walk.simps(2) geometric_process by simp
also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n w"
by (metis lessI pseudo_proj_True_stake stake_nth)
also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n (pseudo_proj_True n w)"
using Suc geometric_process by (metis comp_apply)
also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n (pseudo_proj_True (Suc n) w)"
using geometric_process by (metis Suc.hyps comp_apply pseudo_proj_True_proj_Suc)
also have "... = geom_proc (Suc n) (pseudo_proj_True (Suc n) w)" using geometric_process by simp
finally have "geom_proc (Suc n) w = geom_proc (Suc n) (pseudo_proj_True (Suc n) w)" .
}
thus "geom_proc (Suc n) = geom_proc (Suc n) ∘ (pseudo_proj_True (Suc n))" using geometric_process by auto
next
show "geom_proc 0 = geom_proc 0 ∘ pseudo_proj_True 0" using geometric_process by auto
qed
lemma (in prob_grw) geom_rand_walk_pseudo_proj_False:
shows "geom_proc n = geom_proc n ∘ pseudo_proj_False n"
proof (induct n)
case (Suc n)
let ?tf = "(λTrue ⇒ u | False ⇒ d)"
{
fix w
have "geom_proc (Suc n) w = ?tf (snth w n) * geom_proc n w"
using geom_rand_walk.simps(2) geometric_process by simp
also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n w"
by (metis lessI pseudo_proj_False_stake stake_nth)
also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_False n w)"
using Suc geometric_process by (metis comp_apply)
also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_True n (pseudo_proj_False n w))"
using geometric_process by (metis geom_rand_walk_pseudo_proj_True o_apply)
also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_True n (pseudo_proj_False (Suc n) w))"
unfolding pseudo_proj_True_def pseudo_proj_False_def
by (metis pseudo_proj_False_def pseudo_proj_False_stake pseudo_proj_True_def pseudo_proj_True_proj_Suc)
also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_False (Suc n) w)"
using geometric_process by (metis geom_rand_walk_pseudo_proj_True o_apply)
also have "... = geom_proc (Suc n) (pseudo_proj_False (Suc n) w)" using geometric_process by simp
finally have "geom_proc (Suc n) w = geom_proc (Suc n) (pseudo_proj_False (Suc n) w)" .
}
thus "geom_proc (Suc n) = geom_proc (Suc n) ∘ (pseudo_proj_False (Suc n))" using geometric_process by auto
next
show "geom_proc 0 = geom_proc 0 ∘ pseudo_proj_False 0" using geometric_process by auto
qed
lemma (in prob_grw) geom_rand_walk_borel_adapted:
shows "borel_adapt_stoch_proc nat_filtration geom_proc"
unfolding adapt_stoch_proc_def
proof (auto simp add:nat_discrete_filtration)
fix n
show "geom_proc n ∈ borel_measurable (nat_filtration n)"
proof -
have "geom_proc n ∈ borel_measurable (nat_filtration n)"
proof (rule nat_filtration_comp_measurable)
show "geom_proc n ∈ borel_measurable M"
by (simp add: geom_rand_walk_borel_measurable)
show "geom_proc n ∘ pseudo_proj_True n = geom_proc n"
using geom_rand_walk_pseudo_proj_True by simp
qed
then show ?thesis by simp
qed
qed
lemma (in prob_grw) grw_succ_img:
assumes "(geom_proc n) -` {x} ≠ {}"
shows "(geom_proc (Suc n)) ` ((geom_proc n) -` {x}) = {u*x, d*x}"
proof
have "∃ w. geom_proc n w = x" using assms by auto
from this obtain w where "geom_proc n w = x" by auto
let ?wT = "spick w n True"
let ?wF = "spick w n False"
have bel: "(?wT ∈ (geom_proc n) -` {x}) ∧ (?wF ∈ (geom_proc n) -` {x})"
by (metis ‹geom_proc n w = x› geom_rand_walk_pseudo_proj_True o_def
pseudo_proj_True_stake_image spickI vimage_singleton_eq)
have "geom_proc (Suc n) ?wT = u*x"
proof -
have "x = geom_rand_walk u d init n (spick w n True)"
by (metis ‹geom_proc n w = x› comp_apply geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
then show ?thesis
by (simp add: geometric_process spickI)
qed
moreover have "geom_proc (Suc n) ?wF = d*x"
proof -
have "x = geom_rand_walk u d init n (spick w n False)"
by (metis ‹geom_proc n w = x› comp_apply geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
then show ?thesis
by (simp add: geometric_process spickI)
qed
ultimately show "{u*x, d*x} ⊆ (geom_proc (Suc n)) ` ((geom_proc n) -` {x})" using bel
by (metis empty_subsetI insert_subset rev_image_eqI)
have "∀w ∈ (geom_proc n) -` {x}. geom_proc (Suc n) w ∈ {u*x, d*x}"
proof
fix w
assume "w ∈ (geom_proc n) -` {x}"
have dis: "((snth w (Suc n)) = True) ∨ (snth w (Suc n) = False)" by simp
show "geom_proc (Suc n) w ∈ {u*x, d*x}"
proof -
have "geom_proc n w = x"
by (metis ‹w ∈ geom_proc n -` {x}› vimage_singleton_eq)
then have "geom_rand_walk u d init n w = x"
using geometric_process by blast
then show ?thesis
by (simp add: case_bool_if geometric_process)
qed
qed
thus "(geom_proc (Suc n)) ` ((geom_proc n) -` {x}) ⊆ {u*x, d*x}" by auto
qed
lemma (in prob_grw) geom_rand_walk_strictly_positive:
assumes "0 < init"
and "0 < d"
and "d < u"
shows "∀ n w. 0 < geom_proc n w"
proof (intro allI)
fix n
fix w
show "0 < geom_proc n w"
proof (induct n)
case 0 thus ?case using assms geometric_process by simp
next
case (Suc n)
thus ?case
proof (cases "snth w n")
case True
hence "geom_proc (Suc n) w = u * geom_proc n w" using geom_rand_walk.simps geometric_process by simp
also have "... > 0" using Suc assms by simp
finally show ?thesis .
next
case False
hence "geom_proc (Suc n) w = d * geom_proc n w" using geom_rand_walk.simps geometric_process by simp
also have "... > 0" using Suc assms by simp
finally show ?thesis .
qed
qed
qed
lemma (in prob_grw) geom_rand_walk_diff_induct:
shows "⋀w. (geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = (geom_proc n w * (u - d))"
proof -
fix w
have "geom_proc (Suc n) (spick w n True) = u * geom_proc n w"
proof -
have "snth (spick w n True) n = True" by (simp add: spickI)
hence "(λw. (case w !! n of True ⇒ u | False ⇒ d)) (spick w n True) = u" by simp
thus ?thesis using geometric_process geom_rand_walk.simps(2)[of u d init n]
by (metis comp_apply geom_rand_walk_pseudo_proj_True pseudo_proj_True_def spickI)
qed
moreover have "geom_proc (Suc n) (spick w n False) = d * geom_proc n w"
proof -
have "snth (spick w n False) n = False" by (simp add: spickI)
hence "(λw. (case w !! n of True ⇒ u | False ⇒ d)) (spick w n False) = d" by simp
thus ?thesis using geometric_process geom_rand_walk.simps(2)[of u d init n]
by (metis comp_apply geom_rand_walk_pseudo_proj_True pseudo_proj_True_def spickI)
qed
ultimately show "(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = (geom_proc n w * (u - d))"
by (simp add:field_simps)
qed
end
Theory Fair_Price
section ‹Fair Prices›
text ‹This section contains the formalization of financial notions, such as markets, price processes, portfolios,
arbitrages, fair prices, etc. It also defines risk-neutral probability spaces, and proves the main result about the fair
price of a derivative in a risk-neutral probability space, namely that this fair price is equal to the expectation of
the discounted value of the derivative's payoff.›
theory Fair_Price imports Filtration Martingale Geometric_Random_Walk
begin
subsection ‹Preliminary results›
lemma (in prob_space) finite_borel_measurable_integrable:
assumes "f∈ borel_measurable M"
and "finite (f`(space M))"
shows "integrable M f"
proof -
have "simple_function M f" using assms by (simp add: simple_function_borel_measurable)
moreover have "emeasure M {y ∈ space M. f y ≠ 0} ≠ ∞" by simp
ultimately have "Bochner_Integration.simple_bochner_integrable M f"
using Bochner_Integration.simple_bochner_integrable.simps by blast
hence "has_bochner_integral M f (Bochner_Integration.simple_bochner_integral M f)"
using has_bochner_integral_simple_bochner_integrable by auto
thus ?thesis using integrable.simps by auto
qed
subsubsection ‹On the almost everywhere filter›
lemma AE_eq_trans[trans]:
assumes "AE x in M. A x = B x"
and "AE x in M. B x = C x"
shows "AE x in M. A x = C x"
using assms by auto
abbreviation AEeq where "AEeq M X Y ≡ AE w in M. X w = Y w"
lemma AE_add:
assumes "AE w in M. f w = g w"
and "AE w in M. f' w = g' w"
shows "AE w in M. f w + f' w = g w + g' w" using assms by auto
lemma AE_sum:
assumes "finite I"
and "∀ i∈I. AE w in M. f i w = g i w"
shows "AE w in M. (∑i∈ I. f i w) = (∑i∈ I. g i w)" using assms(1) subset_refl[of I]
proof (induct rule: finite_subset_induct)
case empty
then show ?case by simp
next
case (insert a F)
have "AEeq M (f a) (g a)" using assms(2) insert.hyps(2) by auto
have "AE w in M. (∑i∈ insert a F. f i w) = f a w + (∑i∈ F. f i w)"
by (simp add: insert.hyps(1) insert.hyps(3))
also have "AE w in M. f a w + (∑i∈ F. f i w) = g a w + (∑i∈ F. f i w)"
using ‹AEeq M (f a) (g a)› by auto
also have "AE w in M. g a w + (∑i∈ F. f i w) = g a w + (∑i∈ F. g i w)"
using insert.hyps(4) by auto
also have "AE w in M. g a w + (∑i∈ F. g i w) = (∑i∈ insert a F. g i w)"
by (simp add: insert.hyps(1) insert.hyps(3))
finally show ?case by auto
qed
lemma AE_eq_cst:
assumes "AE w in M. (λw. c) w = (λw. d) w"
and "emeasure M (space M) ≠ 0"
shows "c = d"
proof (rule ccontr)
assume "c ≠ d"
from ‹AE w in M. (λw. c) w = (λw. d) w› obtain N where Nprops: "{w∈ space M. ¬(λw. c) w = (λw. d) w} ⊆ N" "N∈ sets M" "emeasure M N = 0"
by (force elim:AE_E)
have "∀w∈ space M. (λw. c) w ≠ (λw. d) w" using ‹c≠ d› by simp
hence "{w∈ space M. (λw. c) w ≠ (λw. d) w} = space M" by auto
hence "space M⊆ N" using Nprops by auto
thus False using ‹emeasure M N = 0› assms
by (meson Nprops(2) ‹emeasure M (space M) ≠ 0› ‹emeasure M N = 0› ‹space M ⊆ N› emeasure_eq_0)
qed
subsubsection ‹On conditional expectations›
lemma (in prob_space) subalgebra_sigma_finite:
assumes "subalgebra M N"
shows "sigma_finite_subalgebra M N" unfolding sigma_finite_subalgebra_def by (simp add: assms prob_space_axioms prob_space_imp_sigma_finite prob_space_restr_to_subalg)
lemma (in prob_space) trivial_subalg_cond_expect_AE:
assumes "subalgebra M N"
and "sets N = {{}, space M}"
and "integrable M f"
shows "AE x in M. real_cond_exp M N f x = (λx. expectation f) x"
proof (intro sigma_finite_subalgebra.real_cond_exp_charact)
show "sigma_finite_subalgebra M N" by (simp add: assms(1) subalgebra_sigma_finite)
show "integrable M f" using assms by simp
show "integrable M (λx. expectation f)" by auto
show "(λx. expectation f) ∈ borel_measurable N" by simp
show "⋀A. A ∈ sets N ⟹ set_lebesgue_integral M A f = ∫x∈A. expectation f∂M"
proof -
fix A
assume "A ∈ sets N"
show "set_lebesgue_integral M A f = ∫x∈A. expectation f∂M"
proof (cases "A = {}")
case True
thus ?thesis by (simp add: set_lebesgue_integral_def)
next
case False
hence "A = space M" using assms ‹A∈ sets N› by auto
have "set_lebesgue_integral M A f = expectation f" using ‹A = space M›
by (metis (mono_tags, lifting) Bochner_Integration.integral_cong indicator_simps(1)
scaleR_one set_lebesgue_integral_def)
also have "... =∫x∈A. expectation f∂M" using ‹A = space M›
by (auto simp add:prob_space set_lebesgue_integral_def)
finally show ?thesis .
qed
qed
qed
lemma (in prob_space) triv_subalg_borel_eq:
assumes "subalgebra M F"
and "sets F = {{}, space M}"
and "AE x in M. f x = (c::'b::{t2_space})"
and "f∈ borel_measurable F"
shows "∀x∈ space M. f x = c"
proof
fix x
assume "x∈ space M"
have "space M = space F" using assms by (simp add:subalgebra_def)
hence "x∈ space F" using ‹x∈ space M› by simp
have "space M ≠ {}" by (simp add:not_empty)
hence "∃d. ∀y∈ space F. f y = d" by (metis assms(1) assms(2) assms(4) subalgebra_def triv_measurable_cst)
from this obtain d where "∀y ∈space F. f y = d" by auto
hence "f x = d" using ‹x∈ space F› by simp
also have "... = c"
proof (rule ccontr)
assume "d≠ c"
from ‹AE x in M. f x= c› obtain N where Nprops: "{x∈ space M. ¬f x = c} ⊆ N" "N∈ sets M" "emeasure M N = 0"
by (force elim:AE_E)
have "space M ⊆ {x∈ space M. ¬f x = c}" using ‹∀y ∈space F. f y = d› ‹space M = space F› ‹d≠ c› by auto
hence "space M⊆ N" using Nprops by auto
thus False using ‹emeasure M N = 0› emeasure_space_1 Nprops(2) emeasure_mono by fastforce
qed
finally show "f x = c" .
qed
lemma (in prob_space) trivial_subalg_cond_expect_eq:
assumes "subalgebra M N"
and "sets N = {{}, space M}"
and "integrable M f"
shows "∀x∈ space M. real_cond_exp M N f x = expectation f"
proof (rule triv_subalg_borel_eq)
show "subalgebra M N" "sets N = {{}, space M}" using assms by auto
show "real_cond_exp M N f ∈ borel_measurable N" by simp
show "AE x in M. real_cond_exp M N f x = expectation f"
by (rule trivial_subalg_cond_expect_AE, (auto simp add:assms))
qed
lemma (in sigma_finite_subalgebra) real_cond_exp_cong':
assumes "∀w ∈ space M. f w = g w"
and "f∈ borel_measurable M"
shows "AE w in M. real_cond_exp M F f w = real_cond_exp M F g w"
proof (rule real_cond_exp_cong)
show "AE w in M. f w = g w" using assms by simp
show "f∈ borel_measurable M" using assms by simp
show "g∈ borel_measurable M" using assms by (metis measurable_cong)
qed
lemma (in sigma_finite_subalgebra) real_cond_exp_bsum :
fixes f::"'b ⇒ 'a ⇒ real"
assumes [measurable]: "⋀i. i∈I ⟹ integrable M (f i)"
shows "AE x in M. real_cond_exp M F (λx. ∑i∈I. f i x) x = (∑i∈I. real_cond_exp M F (f i) x)"
proof (rule real_cond_exp_charact)
fix A assume [measurable]: "A ∈ sets F"
then have A_meas [measurable]: "A ∈ sets M" by (meson subsetD subalg subalgebra_def)
have *: "⋀i. i ∈ I ⟹ integrable M (λx. indicator A x * f i x)"
using integrable_mult_indicator[OF ‹A ∈ sets M› assms(1)] by auto
have **: "⋀i. i ∈ I ⟹ integrable M (λx. indicator A x * real_cond_exp M F (f i) x)"
using integrable_mult_indicator[OF ‹A ∈ sets M› real_cond_exp_int(1)[OF assms(1)]] by auto
have inti: "⋀i. i ∈ I ⟹(∫x. indicator A x * f i x ∂M) = (∫x. indicator A x * real_cond_exp M F (f i) x ∂M)" using
real_cond_exp_intg(2)[symmetric,of "indicator A" ]
using "*" ‹A ∈ sets F› assms borel_measurable_indicator by blast
have "(∫x∈A. (∑i∈I. f i x)∂M) = (∫x. (∑i∈I. indicator A x * f i x)∂M)"
by (simp add: sum_distrib_left set_lebesgue_integral_def)
also have "... = (∑i∈I. (∫x. indicator A x * f i x ∂M))" using Bochner_Integration.integral_sum[of I M "λi x. indicator A x * f i x"] *
by simp
also have "... = (∑i∈I. (∫x. indicator A x * real_cond_exp M F (f i) x ∂M))"
using inti by auto
also have "... = (∫x. (∑i∈I. indicator A x * real_cond_exp M F (f i) x)∂M)"
by (rule Bochner_Integration.integral_sum[symmetric], simp add: **)
also have "... = (∫x∈A. (∑i∈I. real_cond_exp M F (f i) x)∂M)"
by (simp add: sum_distrib_left set_lebesgue_integral_def)
finally show "(∫x∈A. (∑i∈I. f i x)∂M) = (∫x∈A. (∑i∈I. real_cond_exp M F (f i) x)∂M)" by auto
qed (auto simp add: assms real_cond_exp_int(1)[OF assms(1)])
subsection ‹Financial formalizations›
subsubsection ‹Markets›
definition stk_strict_subs::"'c set ⇒ bool" where
"stk_strict_subs S ⟷ S ≠ UNIV"
typedef ('a,'c) discrete_market = "{(s::('c set), a::'c ⇒ (nat ⇒ 'a ⇒ real)). stk_strict_subs s}" unfolding stk_strict_subs_def by fastforce
definition prices where
"prices Mkt = (snd (Rep_discrete_market Mkt))"
definition assets where
"assets Mkt = UNIV"
definition stocks where
"stocks Mkt = (fst (Rep_discrete_market Mkt))"
definition discrete_market_of
where
"discrete_market_of S A =
Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)"
lemma prices_of:
shows "prices (discrete_market_of S A) = A"
proof -
have "stk_strict_subs (if (stk_strict_subs S) then S else {})"
proof (cases "stk_strict_subs S")
case True thus ?thesis by simp
next
case False thus ?thesis unfolding stk_strict_subs_def by simp
qed
hence fct: "((if (stk_strict_subs S) then S else {}), A) ∈ {(s, a). stk_strict_subs s}" by simp
have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct by simp
thus ?thesis unfolding prices_def by simp
qed
lemma stocks_of:
assumes "UNIV ≠ S"
shows "stocks (discrete_market_of S A) = S"
proof -
have "stk_strict_subs S" using assms unfolding stk_strict_subs_def by simp
hence fct: "((if (stk_strict_subs S) then S else {}), A) ∈ {(s, a). stk_strict_subs s}" by simp
have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct by simp
thus ?thesis unfolding stocks_def using ‹stk_strict_subs S› by simp
qed
lemma mkt_stocks_assets:
shows "stk_strict_subs (stocks Mkt)" unfolding stocks_def prices_def
by (metis Rep_discrete_market mem_Collect_eq split_beta')
subsubsection ‹Quantity processes and portfolios›
text ‹These are functions that assign quantities to assets; each quantity is a stochastic process. Basic
operations are defined on these processes.›
paragraph ‹Basic operations›
definition qty_empty where
"qty_empty = (λ (x::'a) (n::nat) w. 0::real)"
definition qty_single where
"qty_single asset qt_proc = (qty_empty(asset := qt_proc))"
definition qty_sum::"('b ⇒ nat ⇒ 'a ⇒ real) ⇒ ('b ⇒ nat ⇒ 'a ⇒ real) ⇒ ('b ⇒ nat ⇒ 'a ⇒ real)" where
"qty_sum pf1 pf2 = (λx n w. pf1 x n w + pf2 x n w)"
definition qty_mult_comp::"('b ⇒ nat ⇒ 'a ⇒ real) ⇒ (nat ⇒ 'a ⇒ real) ⇒ ('b ⇒ nat ⇒ 'a ⇒ real)" where
"qty_mult_comp pf1 qty = (λx n w. (pf1 x n w) * (qty n w))"
definition qty_rem_comp::"('b ⇒ nat ⇒ 'a ⇒ real) ⇒ 'b ⇒ ('b ⇒ nat ⇒ 'a ⇒ real)" where
"qty_rem_comp pf1 x = pf1(x:=(λn w. 0))"
definition qty_replace_comp where
"qty_replace_comp pf1 x pf2 = qty_sum (qty_rem_comp pf1 x) (qty_mult_comp pf2 (pf1 x))"
paragraph ‹Support sets›
text ‹If p x n w is different from 0, this means that this quantity is held on interval ]n-1, n].›
definition support_set::"('b ⇒ nat ⇒ 'a ⇒ real) ⇒ 'b set" where
"support_set p = {x. ∃ n w. p x n w ≠ 0}"
lemma qty_empty_support_set:
shows "support_set qty_empty = {}" unfolding support_set_def qty_empty_def by simp
lemma sum_support_set:
shows "support_set (qty_sum pf1 pf2) ⊆ (support_set pf1) ∪ (support_set pf2)"
proof (intro subsetI, rule ccontr)
fix x
assume "x∈ support_set (qty_sum pf1 pf2)" and "x ∉ support_set pf1 ∪ support_set pf2" note xprops = this
hence "∃ n w. (qty_sum pf1 pf2) x n w ≠ 0" by (simp add: support_set_def)
from this obtain n w where "(qty_sum pf1 pf2) x n w ≠ 0" by auto note nwprops = this
have "pf1 x n w = 0" "pf2 x n w = 0" using xprops by (auto simp add:support_set_def)
hence "(qty_sum pf1 pf2) x n w = 0" unfolding qty_sum_def by simp
thus False using nwprops by simp
qed
lemma mult_comp_support_set:
shows "support_set (qty_mult_comp pf1 qty) ⊆ (support_set pf1)"
proof (intro subsetI, rule ccontr)
fix x
assume "x∈ support_set (qty_mult_comp pf1 qty)" and "x ∉ support_set pf1" note xprops = this
hence "∃ n w. (qty_mult_comp pf1 qty) x n w ≠ 0" by (simp add: support_set_def)
from this obtain n w where "qty_mult_comp pf1 qty x n w ≠ 0" by auto note nwprops = this
have "pf1 x n w = 0" using xprops by (simp add:support_set_def)
hence "(qty_mult_comp pf1 qty) x n w = 0" unfolding qty_mult_comp_def by simp
thus False using nwprops by simp
qed
lemma remove_comp_support_set:
shows "support_set (qty_rem_comp pf1 x) ⊆ ((support_set pf1) - {x})"
proof (intro subsetI, rule ccontr)
fix y
assume "y∈ support_set (qty_rem_comp pf1 x)" and "y ∉ support_set pf1 - {x}" note xprops = this
hence "y∉ support_set pf1 ∨ y = x" by simp
have "∃ n w. (qty_rem_comp pf1 x) y n w ≠ 0" using xprops by (simp add: support_set_def)
from this obtain n w where "(qty_rem_comp pf1 x) y n w ≠ 0" by auto note nwprops = this
show False
proof (cases "y∉ support_set pf1")
case True
hence "pf1 y n w = 0" using xprops by (simp add:support_set_def)
hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
thus ?thesis using nwprops by (metis ‹pf1 y n w = 0› fun_upd_apply qty_rem_comp_def)
next
case False
hence "y = x" using ‹y∉ support_set pf1 ∨ y = x› by simp
hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
thus ?thesis using nwprops by (simp add: ‹y = x›)
qed
qed
lemma replace_comp_support_set:
shows "support_set (qty_replace_comp pf1 x pf2) ⊆ (support_set pf1 - {x}) ∪ support_set pf2"
proof -
have "support_set (qty_replace_comp pf1 x pf2) ⊆ support_set (qty_rem_comp pf1 x) ∪ support_set (qty_mult_comp pf2 (pf1 x))"
unfolding qty_replace_comp_def by (simp add:sum_support_set)
also have "... ⊆ (support_set pf1 - {x}) ∪ support_set pf2" using remove_comp_support_set mult_comp_support_set
by (metis sup.mono)
finally show ?thesis .
qed
lemma single_comp_support:
shows "support_set (qty_single asset qty) ⊆ {asset}"
proof
fix x
assume "x∈ support_set (qty_single asset qty)"
show "x∈ {asset}"
proof (rule ccontr)
assume "x∉ {asset}"
hence "x≠ asset" by auto
have "∃ n w. qty_single asset qty x n w ≠ 0" using ‹x∈ support_set (qty_single asset qty)›
by (simp add:support_set_def)
from this obtain n w where "qty_single asset qty x n w ≠ 0" by auto
thus False using ‹x≠asset› by (simp add: qty_single_def qty_empty_def)
qed
qed
lemma single_comp_nz_support:
assumes "∃ n w. qty n w≠ 0"
shows "support_set (qty_single asset qty) = {asset}"
proof
show "support_set (qty_single asset qty) ⊆ {asset}" by (simp add: single_comp_support)
have "asset∈ support_set (qty_single asset qty)" using assms unfolding support_set_def qty_single_def by simp
thus "{asset} ⊆ support_set (qty_single asset qty)" by auto
qed
paragraph ‹Portfolios›
definition portfolio where
"portfolio p ⟷ finite (support_set p)"
definition stock_portfolio :: "('a, 'b) discrete_market ⇒ ('b ⇒ nat ⇒ 'a ⇒ real) ⇒ bool" where
"stock_portfolio Mkt p ⟷ portfolio p ∧ support_set p ⊆ stocks Mkt"
lemma sum_portfolio:
assumes "portfolio pf1"
and "portfolio pf2"
shows "portfolio (qty_sum pf1 pf2)" unfolding portfolio_def
proof -
have "support_set (qty_sum pf1 pf2) ⊆ (support_set pf1) ∪ (support_set pf2)" by (simp add: sum_support_set)
thus "finite (support_set (qty_sum pf1 pf2))" using assms unfolding portfolio_def using infinite_super by auto
qed
lemma sum_basic_support_set:
assumes "stock_portfolio Mkt pf1"
and "stock_portfolio Mkt pf2"
shows "stock_portfolio Mkt (qty_sum pf1 pf2)" using assms sum_support_set[of pf1 pf2] unfolding stock_portfolio_def
by (metis Diff_subset_conv gfp.leq_trans subset_Un_eq sum_portfolio)
lemma mult_comp_portfolio:
assumes "portfolio pf1"
shows "portfolio (qty_mult_comp pf1 qty)" unfolding portfolio_def
proof -
have "support_set (qty_mult_comp pf1 qty) ⊆ (support_set pf1)" by (simp add: mult_comp_support_set)
thus "finite (support_set (qty_mult_comp pf1 qty))" using assms unfolding portfolio_def using infinite_super by auto
qed
lemma mult_comp_basic_support_set:
assumes "stock_portfolio Mkt pf1"
shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
using mult_comp_portfolio by blast
lemma remove_comp_portfolio:
assumes "portfolio pf1"
shows "portfolio (qty_rem_comp pf1 x)" unfolding portfolio_def
proof -
have "support_set (qty_rem_comp pf1 x) ⊆ (support_set pf1)" using remove_comp_support_set[of pf1 x] by blast
thus "finite (support_set (qty_rem_comp pf1 x))" using assms unfolding portfolio_def using infinite_super by auto
qed
lemma remove_comp_basic_support_set:
assumes "stock_portfolio Mkt pf1"
shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
using mult_comp_portfolio by blast
lemma replace_comp_portfolio:
assumes "portfolio pf1"
and "portfolio pf2"
shows "portfolio (qty_replace_comp pf1 x pf2)" unfolding portfolio_def
proof -
have "support_set (qty_replace_comp pf1 x pf2) ⊆ (support_set pf1) ∪ (support_set pf2)" using replace_comp_support_set[of pf1 x pf2] by blast
thus "finite (support_set (qty_replace_comp pf1 x pf2))" using assms unfolding portfolio_def using infinite_super by auto
qed
lemma replace_comp_stocks:
assumes "support_set pf1 ⊆ stocks Mkt ∪ {x}"
and "support_set pf2 ⊆ stocks Mkt"
shows "support_set (qty_replace_comp pf1 x pf2) ⊆ stocks Mkt"
proof -
have "support_set (qty_rem_comp pf1 x) ⊆ stocks Mkt" using assms(1) remove_comp_support_set by fastforce
moreover have "support_set (qty_mult_comp pf2 (pf1 x)) ⊆ stocks Mkt" using assms mult_comp_support_set by fastforce
ultimately show ?thesis unfolding qty_replace_comp_def using sum_support_set by fastforce
qed
lemma single_comp_portfolio:
shows "portfolio (qty_single asset qty)"
by (meson finite.emptyI finite.insertI finite_subset portfolio_def single_comp_support)
paragraph ‹Value processes›
definition val_process where
"val_process Mkt p = (if (¬ (portfolio p)) then (λ n w. 0)
else (λ n w . (sum (λx. ((prices Mkt) x n w) * (p x (Suc n) w)) (support_set p))))"
lemma subset_val_process':
assumes "finite A"
and "support_set p ⊆ A"
shows "val_process Mkt p n w = (sum (λx. ((prices Mkt) x n w) * (p x (Suc n) w)) A)"
proof -
have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
have "∃C. (support_set p) ∩ C = {} ∧ (support_set p) ∪ C = A" using assms(2) by auto
from this obtain C where "(support_set p) ∩ C = {}" and "(support_set p) ∪ C = A" by auto note Cprops = this
have "finite C" using assms ‹(support_set p) ∪ C = A› by auto
have "∀x∈ C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
hence "(∑x∈ C. ((prices Mkt) x n w) * (p x (Suc n) w)) = 0" by simp
hence "val_process Mkt p n w = (∑x∈ (support_set p). ((prices Mkt) x n w) * (p x (Suc n) w))
+ (∑x∈ C. ((prices Mkt) x n w) * (p x (Suc n) w))" unfolding val_process_def using ‹portfolio p› by simp
also have "... = (∑ x∈ A. ((prices Mkt) x n w) * (p x (Suc n) w))"
using ‹portfolio p› ‹finite C› Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
finally show "val_process Mkt p n w = (∑ x∈ A. ((prices Mkt) x n w) * (p x (Suc n) w))" .
qed
lemma sum_val_process:
assumes "portfolio pf1"
and "portfolio pf2"
shows "∀n w. val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w"
proof (intro allI)
fix n w
have vp1: "val_process Mkt pf1 n w = (∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
proof -
have "finite (support_set pf1 ∪ support_set pf2) ∧ support_set pf1 ⊆ support_set pf1 ∪ support_set pf2"
by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
then show ?thesis
by (simp add: subset_val_process')
qed
have vp2: "val_process Mkt pf2 n w = (∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
proof -
have "finite (support_set pf1 ∪ support_set pf2) ∧ support_set pf2 ⊆ support_set pf2 ∪ support_set pf1"
by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
then show ?thesis
by (simp add: subset_val_process')
qed
have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
have fin:"finite (support_set pf1 ∪ support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w =
(∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w)) +
(∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
using vp1 vp2 by simp
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
(((prices Mkt) x n w) * (pf1 x (Suc n) w)) + ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
by (simp add: sum.distrib)
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
((prices Mkt) x n w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
also have "... = (∑ x∈ (support_set (qty_sum pf1 pf2)).
((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
subset_val_process'[of "support_set pf1∪ support_set pf2" "qty_sum pf1 pf2"] pf fin unfolding val_process_def by simp
also have "... = val_process Mkt (qty_sum pf1 pf2) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
finally have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w = val_process Mkt (qty_sum pf1 pf2) n w" .
thus "val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w" ..
qed
lemma mult_comp_val_process:
assumes "portfolio pf1"
shows "∀n w. val_process Mkt (qty_mult_comp pf1 qty) n w = ((val_process Mkt pf1) n w) * (qty (Suc n) w)"
proof (intro allI)
fix n w
have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
have "((val_process Mkt pf1) n w) * (qty (Suc n) w) =
(∑ x∈ (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
unfolding val_process_def using assms by simp
also have "... = (∑ x∈ (support_set pf1).
(((prices Mkt) x n w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
also have "... = (∑ x∈ (support_set pf1).
((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
by (simp add: mult.commute mult.left_commute)
also have "... = (∑ x∈ (support_set (qty_mult_comp pf1 qty)).
((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1]
subset_val_process'[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin unfolding val_process_def by simp
also have "... = val_process Mkt (qty_mult_comp pf1 qty) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
finally have "(val_process Mkt pf1) n w * (qty (Suc n) w) = val_process Mkt (qty_mult_comp pf1 qty) n w" .
thus "val_process Mkt (qty_mult_comp pf1 qty) n w = (val_process Mkt pf1) n w * (qty (Suc n) w)" ..
qed
lemma remove_comp_values:
assumes "x ≠ y"
shows "∀n w. pf1 x n w = (qty_rem_comp pf1 y) x n w"
proof (intro allI)
fix n w
show "pf1 x n w = (qty_rem_comp pf1 y) x n w" by (simp add: assms qty_rem_comp_def)
qed
lemma remove_comp_val_process:
assumes "portfolio pf1"
shows "∀n w. val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)"
proof (intro allI)
fix n w
have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
hence fin2: "finite (support_set pf1 - {y})" by simp
have "((val_process Mkt pf1) n w) =
(∑ x∈ (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
unfolding val_process_def using assms by simp
also have "... = (∑ x∈ (support_set pf1 - {y}).
(((prices Mkt) x n w) * (pf1 x (Suc n) w))) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
proof (cases "y∈ support_set pf1")
case True
thus ?thesis by (simp add: fin sum_diff1)
next
case False
hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
thus ?thesis by (simp add: fin sum_diff1)
qed
also have "... = (∑ x∈ (support_set pf1 - {y}).
((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
proof -
have "(∑ x∈ (support_set pf1 - {y}). (((prices Mkt) x n w) * (pf1 x (Suc n) w))) =
(∑ x∈ (support_set pf1 - {y}). ((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
proof (rule sum.cong,simp)
fix x
assume "x∈ support_set pf1 - {y}"
show "prices Mkt x n w * pf1 x (Suc n) w = prices Mkt x n w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
by (metis DiffD2 ‹x ∈ support_set pf1 - {y}› singletonI)
qed
thus ?thesis by simp
qed
also have "... = (val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
using subset_val_process'[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
by (simp add: remove_comp_support_set)
finally have "(val_process Mkt pf1) n w =
(val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)" .
thus "val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)" by simp
qed
lemma replace_comp_val_process:
assumes "∀n w. prices Mkt x n w = val_process Mkt pf2 n w"
and "portfolio pf1"
and "portfolio pf2"
shows "∀n w. val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w"
proof (intro allI)
fix n w
have "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt (qty_rem_comp pf1 x) n w +
val_process Mkt (qty_mult_comp pf2 (pf1 x)) n w" unfolding qty_replace_comp_def using assms
sum_val_process[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
by (simp add: mult_comp_portfolio remove_comp_portfolio)
also have "... = val_process Mkt pf1 n w - (prices Mkt x n w * pf1 x (Suc n) w) + val_process Mkt pf2 n w * pf1 x (Suc n) w"
by (simp add: assms(2) assms(3) mult_comp_val_process remove_comp_val_process)
also have "... = val_process Mkt pf1 n w" using assms by simp
finally show "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w" .
qed
lemma qty_single_val_process:
shows "val_process Mkt (qty_single asset qty) n w =
prices Mkt asset n w * qty (Suc n) w"
proof -
have "val_process Mkt (qty_single asset qty) n w =
(sum (λx. ((prices Mkt) x n w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
proof (rule subset_val_process')
show "finite {asset}" by simp
show "support_set (qty_single asset qty) ⊆ {asset}" by (simp add: single_comp_support)
qed
also have "... = prices Mkt asset n w * qty (Suc n) w" unfolding qty_single_def by simp
finally show ?thesis .
qed
subsubsection ‹Trading strategies›
locale disc_equity_market = triv_init_disc_filtr_prob_space +
fixes Mkt::"('a,'b) discrete_market"
paragraph ‹Discrete predictable processes›
paragraph ‹Trading strategy›
definition (in disc_filtr_prob_space) trading_strategy
where
"trading_strategy p ⟷ portfolio p ∧ (∀asset ∈ support_set p. borel_predict_stoch_proc F (p asset))"
definition (in disc_filtr_prob_space) support_adapt:: "('a, 'b) discrete_market ⇒ ('b ⇒ nat ⇒ 'a ⇒ real) ⇒ bool" where
"support_adapt Mkt pf ⟷ (∀ asset ∈ support_set pf. borel_adapt_stoch_proc F (prices Mkt asset))"
lemma (in disc_filtr_prob_space) quantity_adapted:
assumes "∀ asset ∈ support_set p. p asset (Suc n) ∈ borel_measurable (F n)"
"∀asset ∈ support_set p. prices Mkt asset n ∈ borel_measurable (F n)"
shows "val_process Mkt p n ∈ borel_measurable (F n)"
proof (cases "portfolio p")
case False
have "val_process Mkt p = (λ n w. 0)" unfolding val_process_def using False by simp
thus "?thesis" by simp
next
case True
hence "val_process Mkt p n = (λw. ∑x∈support_set p. prices Mkt x n w * p x (Suc n) w)"
unfolding val_process_def using True by simp
moreover have "(λw. ∑x∈support_set p. prices Mkt x n w * p x (Suc n) w) ∈ borel_measurable (F n)"
proof (rule borel_measurable_sum)
fix asset
assume "asset∈ support_set p"
hence "p asset (Suc n) ∈ borel_measurable (F n)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
moreover have "prices Mkt asset n ∈ borel_measurable (F n)"
using ‹asset ∈ support_set p› assms(2) unfolding support_adapt_def by (simp add: adapt_stoch_proc_def)
ultimately show "(λx. prices Mkt asset n x * p asset (Suc n) x) ∈ borel_measurable (F n)" by simp
qed
ultimately show "val_process Mkt p n ∈ borel_measurable (F n)" by simp
qed
lemma (in disc_filtr_prob_space) trading_strategy_adapted:
assumes "trading_strategy p"
and "support_adapt Mkt p"
shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
proof (cases "portfolio p")
case False
have "val_process Mkt p = (λ n w. 0)" unfolding val_process_def using False by simp
thus "borel_adapt_stoch_proc F (val_process Mkt p)"
by (simp add: constant_process_borel_adapted)
next
case True
show ?thesis unfolding adapt_stoch_proc_def
proof
fix n
have "val_process Mkt p n = (λw. ∑x∈support_set p. prices Mkt x n w * p x (Suc n) w)"
unfolding val_process_def using True by simp
moreover have "(λw. ∑x∈support_set p. prices Mkt x n w * p x (Suc n) w) ∈ borel_measurable (F n)"
proof (rule borel_measurable_sum)
fix asset
assume "asset∈ support_set p"
hence "p asset (Suc n) ∈ borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def by simp
moreover have "prices Mkt asset n ∈ borel_measurable (F n)"
using ‹asset ∈ support_set p› assms(2) unfolding support_adapt_def by (simp add:adapt_stoch_proc_def)
ultimately show "(λx. prices Mkt asset n x * p asset (Suc n) x) ∈ borel_measurable (F n)" by simp
qed
ultimately show "val_process Mkt p n ∈ borel_measurable (F n)" by simp
qed
qed
lemma (in disc_equity_market) ats_val_process_adapted:
assumes "trading_strategy p"
and "support_adapt Mkt p"
shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
by (meson assms(1) assms(2) subsetCE trading_strategy_adapted)
lemma (in disc_equity_market) trading_strategy_init:
assumes "trading_strategy p"
and "support_adapt Mkt p"
shows "∃c. ∀w ∈ space M. val_process Mkt p 0 w = c" using assms adapted_init ats_val_process_adapted by simp
definition (in disc_equity_market) initial_value where
"initial_value pf = constant_image (val_process Mkt pf 0)"
lemma (in disc_equity_market) initial_valueI:
assumes "trading_strategy pf"
and "support_adapt Mkt pf"
shows "∀w∈ space M. val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def
proof (rule constant_imageI)
show "∃c. ∀w∈space M. val_process Mkt pf 0 w = c" using trading_strategy_init assms by simp
qed
lemma (in disc_equity_market) inc_predict_support_trading_strat:
assumes "trading_strategy pf1"
shows "∀ asset ∈ support_set pf1 ∪ B. borel_predict_stoch_proc F (pf1 asset)"
proof
fix asset
assume "asset ∈ support_set pf1 ∪ B"
show "borel_predict_stoch_proc F (pf1 asset)"
proof (cases "asset ∈ support_set pf1")
case True
thus ?thesis using assms unfolding trading_strategy_def by simp
next
case False
hence "∀n w. pf1 asset n w = 0" unfolding support_set_def by simp
show ?thesis unfolding predict_stoch_proc_def
proof
show "pf1 asset 0 ∈ measurable (F 0) borel" using ‹∀n w. pf1 asset n w = 0›
by (simp add: borel_measurable_const measurable_cong)
next
show "∀n. pf1 asset (Suc n) ∈ borel_measurable (F n)"
proof
fix n
have "∀w. pf1 asset (Suc n) w = 0" using ‹∀n w. pf1 asset n w = 0› by simp
have "0∈ space borel" by simp
thus "pf1 asset (Suc n) ∈ measurable (F n) borel" using measurable_const[of 0 borel "F n"]
by (metis ‹0 ∈ space borel ⟹ (λx. 0) ∈ borel_measurable (F n)› ‹0 ∈ space borel›
‹∀n w. pf1 asset n w = 0› measurable_cong)
qed
qed
qed
qed
lemma (in disc_equity_market) inc_predict_support_trading_strat':
assumes "trading_strategy pf1"
and "asset ∈ support_set pf1∪ B"
shows "borel_predict_stoch_proc F (pf1 asset)"
proof (cases "asset ∈ support_set pf1")
case True
thus ?thesis using assms unfolding trading_strategy_def by simp
next
case False
hence "∀n w. pf1 asset n w = 0" unfolding support_set_def by simp
show ?thesis unfolding predict_stoch_proc_def
proof
show "pf1 asset 0 ∈ measurable (F 0) borel" using ‹∀n w. pf1 asset n w = 0›
by (simp add: borel_measurable_const measurable_cong)
next
show "∀n. pf1 asset (Suc n) ∈ borel_measurable (F n)"
proof
fix n
have "∀w. pf1 asset (Suc n) w = 0" using ‹∀n w. pf1 asset n w = 0› by simp
have "0∈ space borel" by simp
thus "pf1 asset (Suc n) ∈ measurable (F n) borel" using measurable_const[of 0 borel "F n"]
by (metis ‹0 ∈ space borel ⟹ (λx. 0) ∈ borel_measurable (F n)› ‹0 ∈ space borel›
‹∀n w. pf1 asset n w = 0› measurable_cong)
qed
qed
qed
lemma (in disc_equity_market) inc_support_trading_strat:
assumes "trading_strategy pf1"
shows "∀ asset ∈ support_set pf1 ∪ B. borel_adapt_stoch_proc F (pf1 asset)" using assms
by (simp add: inc_predict_support_trading_strat predict_imp_adapt)
lemma (in disc_equity_market) qty_empty_trading_strat:
shows "trading_strategy qty_empty" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio qty_empty"
by (metis fun_upd_triv qty_single_def single_comp_portfolio)
show "⋀asset. asset ∈ support_set qty_empty ⟹ borel_predict_stoch_proc F (qty_empty asset)"
using qty_empty_support_set by auto
qed
lemma (in disc_equity_market) sum_trading_strat:
assumes "trading_strategy pf1"
and "trading_strategy pf2"
shows "trading_strategy (qty_sum pf1 pf2)"
proof -
have "∀ asset ∈ support_set pf1 ∪ support_set pf2. borel_predict_stoch_proc F (pf1 asset)"
using assms by (simp add: inc_predict_support_trading_strat)
have "∀ asset ∈ support_set pf2 ∪ support_set pf1. borel_predict_stoch_proc F (pf2 asset)"
using assms by (simp add: inc_predict_support_trading_strat)
have "∀ asset ∈ support_set pf1 ∪ support_set pf2. borel_predict_stoch_proc F ((qty_sum pf1 pf2) asset)"
proof
fix asset
assume "asset ∈ support_set pf1 ∪ support_set pf2"
show "borel_predict_stoch_proc F (qty_sum pf1 pf2 asset)" unfolding predict_stoch_proc_def qty_sum_def
proof
show "(λw. pf1 asset 0 w + pf2 asset 0 w) ∈ borel_measurable (F 0)"
proof -
have "(λw. pf1 asset 0 w) ∈ borel_measurable (F 0)"
using ‹∀asset∈support_set pf1 ∪ support_set pf2. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1 ∪ support_set pf2› predict_stoch_proc_def by blast
moreover have "(λw. pf2 asset 0 w) ∈ borel_measurable (F 0)"
using ‹∀asset∈support_set pf2 ∪ support_set pf1. borel_predict_stoch_proc F (pf2 asset)›
‹asset ∈ support_set pf1 ∪ support_set pf2› predict_stoch_proc_def by blast
ultimately show ?thesis by simp
qed
next
show "∀n. (λw. pf1 asset (Suc n) w + pf2 asset (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "(λw. pf1 asset (Suc n) w) ∈ borel_measurable (F n)"
using ‹∀asset∈support_set pf1 ∪ support_set pf2. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1 ∪ support_set pf2› predict_stoch_proc_def by blast
moreover have "(λw. pf2 asset (Suc n) w) ∈ borel_measurable (F n)"
using ‹∀asset∈support_set pf2 ∪ support_set pf1. borel_predict_stoch_proc F (pf2 asset)›
‹asset ∈ support_set pf1 ∪ support_set pf2› predict_stoch_proc_def by blast
ultimately show "(λw. pf1 asset (Suc n) w + pf2 asset (Suc n) w) ∈ borel_measurable (F n)" by simp
qed
qed
qed
thus ?thesis unfolding trading_strategy_def using sum_support_set[of pf1 pf2]
by (meson assms(1) assms(2) subsetCE sum_portfolio trading_strategy_def)
qed
lemma (in disc_equity_market) mult_comp_trading_strat:
assumes "trading_strategy pf1"
and "borel_predict_stoch_proc F qty"
shows "trading_strategy (qty_mult_comp pf1 qty)"
proof -
have "∀ asset ∈ support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
using assms unfolding trading_strategy_def by simp
have "∀ asset ∈ support_set pf1. borel_predict_stoch_proc F (qty_mult_comp pf1 qty asset)"
unfolding predict_stoch_proc_def qty_mult_comp_def
proof (intro ballI conjI)
fix asset
assume "asset ∈ support_set pf1"
show "(λw. pf1 asset 0 w * qty 0 w) ∈ borel_measurable (F 0)"
proof -
have "(λw. pf1 asset 0 w) ∈ borel_measurable (F 0)"
using ‹∀asset∈support_set pf1. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1› predict_stoch_proc_def by auto
moreover have "(λw. qty 0 w) ∈ borel_measurable (F 0)" using assms predict_stoch_proc_def by auto
ultimately show "(λw. pf1 asset 0 w * qty 0 w) ∈ borel_measurable (F 0)" by simp
qed
show "∀n. (λw. pf1 asset (Suc n) w * qty (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
have "(λw. pf1 asset (Suc n) w) ∈ borel_measurable (F n)"
using ‹∀asset∈support_set pf1. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1› predict_stoch_proc_def by blast
moreover have "(λw. qty (Suc n) w) ∈ borel_measurable (F n)" using assms predict_stoch_proc_def by blast
ultimately show "(λw. pf1 asset (Suc n) w * qty (Suc n) w) ∈ borel_measurable (F n)" by simp
qed
qed
thus ?thesis unfolding trading_strategy_def using mult_comp_support_set[of pf1 qty]
by (meson assms(1) mult_comp_portfolio subsetCE trading_strategy_def)
qed
lemma (in disc_equity_market) remove_comp_trading_strat:
assumes "trading_strategy pf1"
shows "trading_strategy (qty_rem_comp pf1 x)"
proof -
have "∀ asset ∈ support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
using assms unfolding trading_strategy_def by simp
have "∀ asset ∈ support_set pf1. borel_predict_stoch_proc F (qty_rem_comp pf1 x asset)"
unfolding predict_stoch_proc_def qty_rem_comp_def
proof (intro ballI conjI)
fix asset
assume "asset ∈ support_set pf1"
show "(pf1(x := λn w. 0)) asset 0 ∈ borel_measurable (F 0)"
proof -
show "(λw. (pf1(x := λn w. 0)) asset 0 w) ∈ borel_measurable (F 0)"
proof (cases "asset = x")
case True
thus ?thesis by simp
next
case False
thus "(λw. (pf1(x := λn w. 0)) asset 0 w) ∈ borel_measurable (F 0)"
using ‹∀asset∈support_set pf1. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1› by (simp add: predict_stoch_proc_def)
qed
qed
show "∀n. (λw. (pf1(x := λn w. 0)) asset (Suc n) w) ∈ borel_measurable (F n)"
proof
fix n
show "(λw. (pf1(x := λn w. 0)) asset (Suc n) w) ∈ borel_measurable (F n)"
proof (cases "asset = x")
case True
thus ?thesis by simp
next
case False
thus "(λw. (pf1(x := λn w. 0)) asset (Suc n) w) ∈ borel_measurable (F n)"
using ‹∀asset∈support_set pf1. borel_predict_stoch_proc F (pf1 asset)›
‹asset ∈ support_set pf1› by (simp add: predict_stoch_proc_def)
qed
qed
qed
thus ?thesis unfolding trading_strategy_def using remove_comp_support_set[of pf1 x]
by (metis Diff_empty assms remove_comp_portfolio subsetCE subset_Diff_insert trading_strategy_def)
qed
lemma (in disc_equity_market) replace_comp_trading_strat:
assumes "trading_strategy pf1"
and "trading_strategy pf2"
shows "trading_strategy (qty_replace_comp pf1 x pf2)" unfolding qty_replace_comp_def
proof (rule sum_trading_strat)
show "trading_strategy (qty_rem_comp pf1 x)" using assms by (simp add: remove_comp_trading_strat)
show "trading_strategy (qty_mult_comp pf2 (pf1 x))"
proof (cases "x∈ support_set pf1")
case True
hence "borel_predict_stoch_proc F (pf1 x)" using assms unfolding trading_strategy_def by simp
thus ?thesis using assms by (simp add: mult_comp_trading_strat)
next
case False
thus ?thesis
proof -
obtain nn :: "'c ⇒ ('c ⇒ nat ⇒ 'a ⇒ real) ⇒ nat" and aa :: "'c ⇒ ('c ⇒ nat ⇒ 'a ⇒ real) ⇒ 'a" where
"∀x0 x1. (∃v2 v3. x1 x0 v2 v3 ≠ 0) = (x1 x0 (nn x0 x1) (aa x0 x1) ≠ 0)"
by moura
then have "∀f c. (c ∉ {c. ∃n a. f c n a ≠ 0} ∨ f c (nn c f) (aa c f) ≠ 0) ∧ (c ∈ {c. ∃n a. f c n a ≠ 0} ∨ (∀n a. f c n a = 0))"
by auto
then show ?thesis
proof -
have "⋀f c n a. qty_mult_comp f (pf1 x) (c::'c) n a = 0"
by (metis False ‹∀f c. (c ∉ {c. ∃n a. f c n a ≠ 0} ∨ f c (nn c f) (aa c f) ≠ 0) ∧ (c ∈ {c. ∃n a. f c n a ≠ 0} ∨ (∀n a. f c n a = 0))› mult.commute mult_zero_left qty_mult_comp_def support_set_def)
then show ?thesis
by (metis (no_types) ‹∀f c. (c ∉ {c. ∃n a. f c n a ≠ 0} ∨ f c (nn c f) (aa c f) ≠ 0) ∧ (c ∈ {c. ∃n a. f c n a ≠ 0} ∨ (∀n a. f c n a = 0))› assms(2) mult_comp_portfolio support_set_def trading_strategy_def)
qed
qed
qed
qed
subsubsection ‹Self-financing portfolios›
paragraph ‹Closing value process›
fun up_cl_proc where
"up_cl_proc Mkt p 0 = val_process Mkt p 0" |
"up_cl_proc Mkt p (Suc n) = (λw. ∑x∈support_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"
definition cls_val_process where
"cls_val_process Mkt p = (if (¬ (portfolio p)) then (λ n w. 0)
else (λ n w . up_cl_proc Mkt p n w))"
lemma (in disc_filtr_prob_space) quantity_updated_borel:
assumes "∀n. ∀ asset ∈ support_set p. p asset (Suc n) ∈ borel_measurable (F n)"
and "∀n. ∀asset ∈ support_set p. prices Mkt asset n ∈ borel_measurable (F n)"
shows "∀n. cls_val_process Mkt p n ∈ borel_measurable (F n)"
proof (cases "portfolio p")
case False
have "cls_val_process Mkt p = (λ n w. 0)" unfolding cls_val_process_def using False by simp
thus "?thesis" by simp
next
case True
show "∀n. cls_val_process Mkt p n ∈ borel_measurable (F n)"
proof
fix n
show "cls_val_process Mkt p n ∈ borel_measurable (F n)"
proof (cases "n = 0")
case False
hence "∃m. n = Suc m" using old.nat.exhaust by auto
from this obtain m where "n = Suc m" by auto
have "cls_val_process Mkt p (Suc m) = (λw. ∑x∈support_set p. prices Mkt x (Suc m) w * p x (Suc m) w)"
unfolding cls_val_process_def using True by simp
moreover have "(λw. ∑x∈support_set p. prices Mkt x (Suc m) w * p x (Suc m) w) ∈ borel_measurable (F (Suc m))"
proof (rule borel_measurable_sum)
fix asset
assume "asset∈ support_set p"
hence "p asset (Suc m) ∈ borel_measurable (F m)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
hence "p asset (Suc m) ∈ borel_measurable (F (Suc m))"
using Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
moreover have "prices Mkt asset (Suc m) ∈ borel_measurable (F (Suc m))"
using ‹asset ∈ support_set p› assms(2) unfolding support_adapt_def adapt_stoch_proc_def by blast
ultimately show "(λx. prices Mkt asset (Suc m) x * p asset (Suc m) x) ∈ borel_measurable (F (Suc m))" by simp
qed
ultimately have "cls_val_process Mkt p (Suc m) ∈ borel_measurable (F (Suc m))" by simp
thus ?thesis using ‹n = Suc m› by simp
next
case True
thus "cls_val_process Mkt p n ∈ borel_measurable (F n)"
by (metis (no_types, lifting) assms(1) assms(2) quantity_adapted up_cl_proc.simps(1)
cls_val_process_def val_process_def)
qed
qed
qed
lemma (in disc_equity_market) cls_val_process_adapted:
assumes "trading_strategy p"
and "support_adapt Mkt p"
shows "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
proof (cases "portfolio p")
case False
have "cls_val_process Mkt p = (λ n w. 0)" unfolding cls_val_process_def using False by simp
thus "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
by (simp add: constant_process_borel_adapted)
next
case True
show ?thesis unfolding adapt_stoch_proc_def
proof
fix n
show "cls_val_process Mkt p n ∈ borel_measurable (F n)"
proof (cases "n = 0")
case True
thus "cls_val_process Mkt p n ∈ borel_measurable (F n)"
using up_cl_proc.simps(1) assms
by (metis (no_types, lifting) adapt_stoch_proc_def ats_val_process_adapted cls_val_process_def
val_process_def)
next
case False
hence "∃m. Suc m = n" using not0_implies_Suc by blast
from this obtain m where "Suc m = n" by auto
hence "cls_val_process Mkt p n = up_cl_proc Mkt p n" unfolding cls_val_process_def using True by simp
also have "... = (λw. ∑x∈support_set p. prices Mkt x n w * p x n w)"
using up_cl_proc.simps(2) ‹Suc m = n› by auto
finally have "cls_val_process Mkt p n = (λw. ∑x∈support_set p. prices Mkt x n w * p x n w)" .
moreover have "(λw. ∑x∈support_set p. prices Mkt x n w * p x n w) ∈ borel_measurable (F n)"
proof (rule borel_measurable_sum)
fix asset
assume "asset∈ support_set p"
hence "p asset n ∈ borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def
using Suc_n_not_le_n ‹Suc m = n› increasing_measurable_info nat_le_linear by blast
moreover have "prices Mkt asset n ∈ borel_measurable (F n)" using assms ‹asset ∈ support_set p› unfolding support_adapt_def adapt_stoch_proc_def
using stock_portfolio_def by blast
ultimately show "(λx. prices Mkt asset n x * p asset n x) ∈ borel_measurable (F n)" by simp
qed
ultimately show "cls_val_process Mkt p n ∈ borel_measurable (F n)" by simp
qed
qed
qed
lemma subset_cls_val_process:
assumes "finite A"
and "support_set p ⊆ A"
shows "∀n w. cls_val_process Mkt p (Suc n) w = (sum (λx. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
proof (intro allI)
fix n::nat
fix w::'b
have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
have "∃C. (support_set p) ∩ C = {} ∧ (support_set p) ∪ C = A" using assms(2) by auto
from this obtain C where "(support_set p) ∩ C = {}" and "(support_set p) ∪ C = A" by auto note Cprops = this
have "finite C" using assms ‹(support_set p) ∪ C = A› by auto
have "∀x∈ C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
hence "(∑x∈ C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
hence "cls_val_process Mkt p (Suc n) w = (∑x∈ (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
+ (∑x∈ C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
using ‹portfolio p› up_cl_proc.simps(2)[of Mkt p n] by simp
also have "... = (∑ x∈ A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
using ‹portfolio p› ‹finite C› Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
finally show "cls_val_process Mkt p (Suc n) w = (∑ x∈ A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
qed
lemma subset_cls_val_process':
assumes "finite A"
and "support_set p ⊆ A"
shows "cls_val_process Mkt p (Suc n) w = (sum (λx. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
proof -
have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
have "∃C. (support_set p) ∩ C = {} ∧ (support_set p) ∪ C = A" using assms(2) by auto
from this obtain C where "(support_set p) ∩ C = {}" and "(support_set p) ∪ C = A" by auto note Cprops = this
have "finite C" using assms ‹(support_set p) ∪ C = A› by auto
have "∀x∈ C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
hence "(∑x∈ C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
hence "cls_val_process Mkt p (Suc n) w = (∑x∈ (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
+ (∑x∈ C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
using ‹portfolio p› up_cl_proc.simps(2)[of Mkt p n] by simp
also have "... = (∑ x∈ A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
using ‹portfolio p› ‹finite C› Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
finally show "cls_val_process Mkt p (Suc n) w = (∑ x∈ A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
qed
lemma sum_cls_val_process_Suc:
assumes "portfolio pf1"
and "portfolio pf2"
shows "∀n w. cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w"
proof (intro allI)
fix n w
have vp1: "cls_val_process Mkt pf1 (Suc n) w =
(∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
proof -
have "finite (support_set pf1 ∪ support_set pf2) ∧ support_set pf1 ⊆ support_set pf1 ∪ support_set pf2"
by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
then show ?thesis
by (simp add: subset_cls_val_process)
qed
have vp2: "cls_val_process Mkt pf2 (Suc n) w = (∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
proof -
have "finite (support_set pf1 ∪ support_set pf2) ∧ support_set pf2 ⊆ support_set pf2 ∪ support_set pf1"
by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
then show ?thesis by (auto simp add: subset_cls_val_process)
qed
have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
have fin:"finite (support_set pf1 ∪ support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
(∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) +
(∑ x∈ (support_set pf1)∪ (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
using vp1 vp2 by simp
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
(((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) + ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
by (simp add: sum.distrib)
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
((prices Mkt) x (Suc n) w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
also have "... = (∑ x∈ (support_set pf1)∪ (support_set pf2).
((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
also have "... = (∑ x∈ (support_set (qty_sum pf1 pf2)).
((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
subset_cls_val_process[of "support_set pf1∪ support_set pf2" "qty_sum pf1 pf2"] pf fin
unfolding cls_val_process_def by simp
also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
by (metis (no_types, lifting) pf sum.cong up_cl_proc.simps(2) cls_val_process_def)
finally have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
thus "cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w" ..
qed
lemma sum_cls_val_process0:
assumes "portfolio pf1"
and "portfolio pf2"
shows "∀w. cls_val_process Mkt (qty_sum pf1 pf2) 0 w =
(cls_val_process Mkt pf1) 0 w + (cls_val_process Mkt pf2) 0 w" unfolding cls_val_process_def
by (simp add: sum_val_process assms(1) assms(2) sum_portfolio)
lemma sum_cls_val_process:
assumes "portfolio pf1"
and "portfolio pf2"
shows "∀n w. cls_val_process Mkt (qty_sum pf1 pf2) n w =
(cls_val_process Mkt pf1) n w + (cls_val_process Mkt pf2) n w"
by (metis (no_types, lifting) assms(1) assms(2) sum_cls_val_process0 sum_cls_val_process_Suc up_cl_proc.elims)
lemma mult_comp_cls_val_process0:
assumes "portfolio pf1"
shows "∀w. cls_val_process Mkt (qty_mult_comp pf1 qty) 0 w =
((cls_val_process Mkt pf1) 0 w) * (qty (Suc 0) w)" unfolding cls_val_process_def
by (simp add: assms mult_comp_portfolio mult_comp_val_process)
lemma mult_comp_cls_val_process_Suc:
assumes "portfolio pf1"
shows "∀n w. cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w)"
proof (intro allI)
fix n w
have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
have "((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w) =
(∑ x∈ (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
unfolding cls_val_process_def using assms by simp
also have "... = (∑ x∈ (support_set pf1).
(((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
also have "... = (∑ x∈ (support_set pf1).
((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
by (simp add: mult.commute mult.left_commute)
also have "... = (∑ x∈ (support_set (qty_mult_comp pf1 qty)).
((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1 qty]
subset_cls_val_process[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin up_cl_proc.simps(2)
unfolding cls_val_process_def by simp
also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" by (metis (no_types, lifting) pf sum.cong cls_val_process_def up_cl_proc.simps(2))
finally have "(cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w) = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
thus "cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = (cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w)" ..
qed
lemma remove_comp_cls_val_process0:
assumes "portfolio pf1"
shows "∀w. cls_val_process Mkt (qty_rem_comp pf1 y) 0 w =
((cls_val_process Mkt pf1) 0 w) - (prices Mkt y 0 w)* (pf1 y (Suc 0) w)" unfolding cls_val_process_def
by (simp add: assms remove_comp_portfolio remove_comp_val_process)
lemma remove_comp_cls_val_process_Suc:
assumes "portfolio pf1"
shows "∀n w. cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
proof (intro allI)
fix n w
have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
hence fin2: "finite (support_set pf1 - {y})" by simp
have "((cls_val_process Mkt pf1) (Suc n) w) =
(∑ x∈ (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
unfolding cls_val_process_def using assms by simp
also have "... = (∑ x∈ (support_set pf1 - {y}).
(((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
proof (cases "y∈ support_set pf1")
case True
thus ?thesis by (simp add: fin sum_diff1)
next
case False
hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
thus ?thesis by (simp add: fin sum_diff1)
qed
also have "... = (∑ x∈ (support_set pf1 - {y}).
((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
proof -
have "(∑ x∈ (support_set pf1 - {y}). (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) =
(∑ x∈ (support_set pf1 - {y}). ((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
proof (rule sum.cong,simp)
fix x
assume "x∈ support_set pf1 - {y}"
show "prices Mkt x (Suc n) w * pf1 x (Suc n) w = prices Mkt x (Suc n) w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
by (metis DiffD2 ‹x ∈ support_set pf1 - {y}› singletonI)
qed
thus ?thesis by simp
qed
also have "... = (cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
using subset_cls_val_process[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
by (simp add: remove_comp_support_set)
finally have "(cls_val_process Mkt pf1) (Suc n) w =
(cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" .
thus "cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" by simp
qed
lemma replace_comp_cls_val_process0:
assumes "∀w. prices Mkt x 0 w = cls_val_process Mkt pf2 0 w"
and "portfolio pf1"
and "portfolio pf2"
shows "∀w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w"
proof
fix w
have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt (qty_rem_comp pf1 x) 0 w +
cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) 0 w" unfolding qty_replace_comp_def using assms
sum_cls_val_process0[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
by (simp add: mult_comp_portfolio remove_comp_portfolio)
also have "... = cls_val_process Mkt pf1 0 w - (prices Mkt x 0 w * pf1 x (Suc 0) w) +
cls_val_process Mkt pf2 0 w * pf1 x (Suc 0) w"
by (simp add: assms(2) assms(3) mult_comp_cls_val_process0 remove_comp_cls_val_process0)
also have "... = cls_val_process Mkt pf1 0 w" using assms by simp
finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w" .
qed
lemma replace_comp_cls_val_process_Suc:
assumes "∀n w. prices Mkt x (Suc n) w = cls_val_process Mkt pf2 (Suc n) w"
and "portfolio pf1"
and "portfolio pf2"
shows "∀n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
proof (intro allI)
fix n w
have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt (qty_rem_comp pf1 x) (Suc n) w +
cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) (Suc n) w" unfolding qty_replace_comp_def using assms
sum_cls_val_process_Suc[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
by (simp add: mult_comp_portfolio remove_comp_portfolio)
also have "... = cls_val_process Mkt pf1 (Suc n) w - (prices Mkt x (Suc n) w * pf1 x (Suc n) w) +
cls_val_process Mkt pf2 (Suc n) w * pf1 x (Suc n) w"
by (simp add: assms(2) assms(3) mult_comp_cls_val_process_Suc remove_comp_cls_val_process_Suc)
also have "... = cls_val_process Mkt pf1 (Suc n) w" using assms by simp
finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w" .
qed
lemma replace_comp_cls_val_process:
assumes "∀n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
and "portfolio pf1"
and "portfolio pf2"
shows "∀n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) n w = cls_val_process Mkt pf1 n w"
by (metis (no_types, lifting) assms replace_comp_cls_val_process0 replace_comp_cls_val_process_Suc up_cl_proc.elims)
lemma qty_single_updated:
shows "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
prices Mkt asset (Suc n) w * qty (Suc n) w"
proof -
have "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
(sum (λx. ((prices Mkt) x (Suc n) w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
proof (rule subset_cls_val_process')
show "finite {asset}" by simp
show "support_set (qty_single asset qty) ⊆ {asset}" by (simp add: single_comp_support)
qed
also have "... = prices Mkt asset (Suc n) w * qty (Suc n) w" unfolding qty_single_def by simp
finally show ?thesis .
qed
paragraph ‹Self-financing›
definition self_financing where
"self_financing Mkt p ⟷ (∀n. val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n))"
lemma self_financingE:
assumes "self_financing Mkt p"
shows "∀n. val_process Mkt p n = cls_val_process Mkt p n"
proof
fix n
show "val_process Mkt p n = cls_val_process Mkt p n"
proof (cases "n = 0")
case False
thus ?thesis using assms unfolding self_financing_def
by (metis up_cl_proc.elims)
next
case True
thus ?thesis by (simp add: cls_val_process_def val_process_def)
qed
qed
lemma static_portfolio_self_financing:
assumes "∀ x ∈ support_set p. (∀w i. p x i w = p x (Suc i) w)"
shows "self_financing Mkt p"
unfolding self_financing_def
proof (intro allI impI)
fix n
show "val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n)"
proof (cases "portfolio p")
case False
thus ?thesis unfolding val_process_def cls_val_process_def by simp
next
case True
have "∀w. (∑x∈ support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
cls_val_process Mkt p (Suc n) w"
proof
fix w
show "(∑x∈ support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
cls_val_process Mkt p (Suc n) w"
proof -
have "(∑x∈ support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
(∑x∈ support_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"
proof (rule sum.cong, simp)
fix x
assume "x∈ support_set p"
hence "p x (Suc n) w = p x (Suc (Suc n)) w" using assms by blast
thus "prices Mkt x (Suc n) w * p x (Suc (Suc n)) w = prices Mkt x (Suc n) w * p x (Suc n) w" by simp
qed
also have "... = cls_val_process Mkt p (Suc n) w"
using up_cl_proc.simps(2)[of Mkt p n] by (metis True cls_val_process_def)
finally show ?thesis .
qed
qed
moreover have "∀w. val_process Mkt p (Suc n) w = (∑x∈ support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w)"
unfolding val_process_def using True by simp
ultimately show ?thesis by auto
qed
qed
lemma sum_self_financing:
assumes "portfolio pf1"
and "portfolio pf2"
and "self_financing Mkt pf1"
and "self_financing Mkt pf2"
shows "self_financing Mkt (qty_sum pf1 pf2)"
proof -
have "∀ n w. val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
proof (intro allI)
fix n w
have "val_process Mkt (qty_sum pf1 pf2) (Suc n) w = val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w"
using assms by (simp add:sum_val_process)
also have "... = cls_val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w" using assms
unfolding self_financing_def by simp
also have "... = cls_val_process Mkt pf1 (Suc n) w + cls_val_process Mkt pf2 (Suc n) w"
using assms unfolding self_financing_def by simp
also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" using assms by (simp add: sum_cls_val_process)
finally show "val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
qed
thus ?thesis unfolding self_financing_def by auto
qed
lemma mult_time_constant_self_financing:
assumes "portfolio pf1"
and "self_financing Mkt pf1"
and "∀n w. qty n w = qty (Suc n) w"
shows "self_financing Mkt (qty_mult_comp pf1 qty)"
proof -
have "∀ n w. val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w"
proof (intro allI)
fix n w
have "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = val_process Mkt pf1 (Suc n) w * qty (Suc n) w"
using assms by (simp add:mult_comp_val_process)
also have "... = cls_val_process Mkt pf1 (Suc n) w * qty (Suc n) w" using assms
unfolding self_financing_def by simp
also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" using assms
by (auto simp add: mult_comp_cls_val_process_Suc)
finally show "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
qed
thus ?thesis unfolding self_financing_def by auto
qed
lemma replace_comp_self_financing:
assumes "∀n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
and "portfolio pf1"
and "portfolio pf2"
and "self_financing Mkt pf1"
and "self_financing Mkt pf2"
shows "self_financing Mkt (qty_replace_comp pf1 x pf2)"
proof -
have sfeq: "∀n w. prices Mkt x n w = val_process Mkt pf2 n w" using assms by (simp add: self_financingE)
have "∀ n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
proof (intro allI)
fix n w
have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
using assms by (simp add:replace_comp_cls_val_process)
also have "... = val_process Mkt pf1 (Suc n) w" using assms unfolding self_financing_def by simp
also have "... = val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
using assms sfeq by (simp add: replace_comp_val_process self_financing_def)
finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w" .
qed
thus ?thesis unfolding self_financing_def by auto
qed
paragraph ‹Make a portfolio self-financing›
fun remaining_qty where
init: "remaining_qty Mkt v pf asset 0 = (λw. 0)" |
first: "remaining_qty Mkt v pf asset (Suc 0) = (λw. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))" |
step: "remaining_qty Mkt v pf asset (Suc (Suc n)) = (λw. (remaining_qty Mkt v pf asset (Suc n) w) +
(cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
lemma (in disc_equity_market) remaining_qty_predict':
assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "remaining_qty Mkt v pf asset (Suc n) ∈ borel_measurable (F n)"
proof (induct n)
case 0
have "(λw. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))∈ borel_measurable (F 0)"
proof (rule borel_measurable_divide)
have "val_process Mkt pf 0 ∈ borel_measurable (F 0)" using assms
ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
thus "(λx. v - val_process Mkt pf 0 x) ∈ borel_measurable (F 0)" by simp
show "prices Mkt asset 0 ∈ borel_measurable (F 0)" using assms unfolding adapt_stoch_proc_def by simp
qed
thus ?case by simp
next
case (Suc n)
have "(λw. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/
(prices Mkt asset (Suc n) w)) ∈ borel_measurable (F (Suc n))"
proof (rule borel_measurable_divide)
show "(λw. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)) ∈ borel_measurable (F (Suc n))"
proof (rule borel_measurable_diff)
show "(λw. (cls_val_process Mkt pf (Suc n) w)) ∈ borel_measurable (F (Suc n))"
using assms cls_val_process_adapted unfolding adapt_stoch_proc_def by auto
show "(λw. (val_process Mkt pf (Suc n) w)) ∈ borel_measurable (F (Suc n))"
using assms ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
qed
show "prices Mkt asset (Suc n) ∈ borel_measurable (F (Suc n))" using assms unfolding adapt_stoch_proc_def by simp
qed
moreover have "remaining_qty Mkt v pf asset (Suc n) ∈ borel_measurable (F (Suc n))" using Suc
Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
ultimately show ?case using Suc remaining_qty.simps(3)[of Mkt v pf asset n] by simp
qed
lemma (in disc_equity_market) remaining_qty_predict:
assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "borel_predict_stoch_proc F (remaining_qty Mkt v pf asset)" unfolding predict_stoch_proc_def
proof (intro conjI allI)
show "remaining_qty Mkt v pf asset 0 ∈ borel_measurable (F 0)" using init by simp
fix n
show "remaining_qty Mkt v pf asset (Suc n) ∈ borel_measurable (F n)" using assms by (simp add: remaining_qty_predict')
qed
lemma (in disc_equity_market) remaining_qty_adapt:
assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "remaining_qty Mkt v pf asset n ∈ borel_measurable (F n)"
using adapt_stoch_proc_def assms(1) assms(2) predict_imp_adapt remaining_qty_predict
by (metis assms(3))
lemma (in disc_equity_market) remaining_qty_adapted:
assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "borel_adapt_stoch_proc F (remaining_qty Mkt v pf asset)" using assms unfolding adapt_stoch_proc_def
using assms remaining_qty_adapt by blast
definition self_finance where
"self_finance Mkt v pf (asset::'a) = qty_sum pf (qty_single asset (remaining_qty Mkt v pf asset))"
lemma self_finance_portfolio:
assumes "portfolio pf"
shows "portfolio (self_finance Mkt v pf asset)" unfolding self_finance_def
by (simp add: assms single_comp_portfolio sum_portfolio)
lemma self_finance_init:
assumes "∀w. prices Mkt asset 0 w ≠ 0"
and "portfolio pf"
shows "val_process Mkt (self_finance Mkt v pf asset) 0 w = v"
proof -
define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
have "val_process Mkt (self_finance Mkt v pf asset) 0 w =
val_process Mkt pf 0 w +
val_process Mkt scp 0 w" unfolding scp_def using assms single_comp_portfolio[of asset]
sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
by (simp add: ‹⋀qty. portfolio (qty_single asset qty)› self_finance_def)
also have "... = val_process Mkt pf 0 w +
(sum (λx. ((prices Mkt) x 0 w) * (scp x (Suc 0) w)) {asset})"
using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add: single_comp_support)
also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * scp asset (Suc 0) w" by auto
also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (remaining_qty Mkt v pf asset) (Suc 0) w"
unfolding scp_def qty_single_def by simp
also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)"
by simp
also have "... = val_process Mkt pf 0 w + (v - val_process Mkt pf 0 w)" using assms by simp
also have "... = v" by simp
finally show ?thesis .
qed
lemma self_finance_succ:
assumes "prices Mkt asset (Suc n) w ≠ 0"
and "portfolio pf"
shows "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
cls_val_process Mkt pf (Suc n) w"
proof -
define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
have "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
val_process Mkt pf (Suc n) w +
val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
by (simp add: ‹⋀qty. portfolio (qty_single asset qty)› self_finance_def)
also have "... = val_process Mkt pf (Suc n) w +
(sum (λx. ((prices Mkt) x (Suc n) w) * (scp x (Suc (Suc n)) w)) {asset})"
using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add: single_comp_support)
also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc (Suc n)) w" by auto
also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc (Suc n)) w"
unfolding scp_def qty_single_def by simp
also have "... = val_process Mkt pf (Suc n) w +
prices Mkt asset (Suc n) w *
(remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
by simp
also have "... = val_process Mkt pf (Suc n) w +
prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
prices Mkt asset (Suc n) w * (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w)"
by (simp add: distrib_left)
also have "... = val_process Mkt pf (Suc n) w +
prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)"
using assms by simp
also have "... = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + cls_val_process Mkt pf (Suc n) w" by simp
finally show ?thesis .
qed
lemma self_finance_updated:
assumes "prices Mkt asset (Suc n) w ≠ 0"
and "portfolio pf"
shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
proof -
define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
cls_val_process Mkt pf (Suc n) w +
cls_val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
sum_cls_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
by (simp add: ‹⋀qty. portfolio (qty_single asset qty)› self_finance_def)
also have "... = cls_val_process Mkt pf (Suc n) w +
(sum (λx. ((prices Mkt) x (Suc n) w) * (scp x (Suc n) w)) {asset})"
using subset_cls_val_process[of "{asset}" scp] unfolding scp_def by (auto simp add: single_comp_support)
also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc n) w" by auto
also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
unfolding scp_def qty_single_def by simp
finally show ?thesis .
qed
lemma self_finance_charact:
assumes "∀ n w. prices Mkt asset (Suc n) w ≠ 0"
and "portfolio pf"
shows "self_financing Mkt (self_finance Mkt v pf asset)"
proof-
have "∀n w. val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w"
proof (intro allI)
fix n w
show "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w" using assms self_finance_succ[of Mkt asset]
by (simp add: self_finance_updated)
qed
thus ?thesis unfolding self_financing_def by auto
qed
subsubsection ‹Replicating portfolios›
definition (in disc_filtr_prob_space) price_structure::"('a ⇒ real) ⇒ nat ⇒ real ⇒ (nat ⇒ 'a ⇒ real) ⇒ bool" where
"price_structure pyf T π pr ⟷ ((∀ w∈ space M. pr 0 w = π) ∧ (AE w in M. pr T w = pyf w) ∧ (pr T ∈ borel_measurable (F T)))"
lemma (in disc_filtr_prob_space) price_structure_init:
assumes "price_structure pyf T π pr"
shows "∀ w∈ space M. pr 0 w = π" using assms unfolding price_structure_def by simp
lemma (in disc_filtr_prob_space) price_structure_borel_measurable:
assumes "price_structure pyf T π pr"
shows "pr T ∈ borel_measurable (F T)" using assms unfolding price_structure_def by simp
lemma (in disc_filtr_prob_space) price_structure_maturity:
assumes "price_structure pyf T π pr"
shows "AE w in M. pr T w = pyf w" using assms unfolding price_structure_def by simp
definition (in disc_equity_market) replicating_portfolio where
"replicating_portfolio pf der matur ⟷ (stock_portfolio Mkt pf) ∧ (trading_strategy pf) ∧ (self_financing Mkt pf) ∧
(AE w in M. cls_val_process Mkt pf matur w = der w)"
definition (in disc_equity_market) is_attainable where
"is_attainable der matur ⟷ (∃ pf. replicating_portfolio pf der matur)"
lemma (in disc_equity_market) replicating_price_process:
assumes "replicating_portfolio pf der matur"
and "support_adapt Mkt pf"
shows "price_structure der matur (initial_value pf) (cls_val_process Mkt pf)"
unfolding price_structure_def
proof (intro conjI)
show "AE w in M. cls_val_process Mkt pf matur w = der w" using assms unfolding replicating_portfolio_def by simp
show "∀w∈space M. cls_val_process Mkt pf 0 w = initial_value pf"
proof
fix w
assume "w∈ space M"
thus "cls_val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def using constant_imageI[of "cls_val_process Mkt pf 0"]
trading_strategy_init[of pf] assms replicating_portfolio_def [of pf der matur]
by (simp add: stock_portfolio_def cls_val_process_def)
qed
show "cls_val_process Mkt pf matur ∈ borel_measurable (F matur)" using assms unfolding replicating_portfolio_def
using ats_val_process_adapted[of pf]
cls_val_process_adapted by (simp add:adapt_stoch_proc_def)
qed
subsubsection ‹Arbitrages›
definition (in disc_filtr_prob_space) arbitrage_process
where
"arbitrage_process Mkt p ⟷ (∃ m. (self_financing Mkt p) ∧ (trading_strategy p) ∧
(∀w ∈ space M. val_process Mkt p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt p m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"
lemma (in disc_filtr_prob_space) arbitrage_processE:
assumes "arbitrage_process Mkt p"
shows "(∃ m. (self_financing Mkt p) ∧ (trading_strategy p) ∧
(∀w ∈ space M. cls_val_process Mkt p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt p m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"
using assms disc_filtr_prob_space.arbitrage_process_def disc_filtr_prob_space_axioms self_financingE by fastforce
lemma (in disc_filtr_prob_space) arbitrage_processI:
assumes "(∃ m. (self_financing Mkt p) ∧ (trading_strategy p) ∧
(∀w ∈ space M. cls_val_process Mkt p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt p m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"
shows "arbitrage_process Mkt p" unfolding arbitrage_process_def using assms
by (simp add: self_financingE cls_val_process_def)
definition (in disc_filtr_prob_space) viable_market
where
"viable_market Mkt ⟷ (∀p. stock_portfolio Mkt p ⟶ ¬ arbitrage_process Mkt p)"
lemma (in disc_filtr_prob_space) arbitrage_val_process:
assumes "arbitrage_process Mkt pf1"
and "self_financing Mkt pf2"
and "trading_strategy pf2"
and "∀ n w. cls_val_process Mkt pf1 n w = cls_val_process Mkt pf2 n w"
shows "arbitrage_process Mkt pf2"
proof -
have "(∃ m. (self_financing Mkt pf1) ∧ (trading_strategy pf1) ∧
(∀w ∈ space M. cls_val_process Mkt pf1 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt pf1 m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt pf1 m w > 0))" using assms arbitrage_processE[of Mkt pf1] by simp
from this obtain m where "(self_financing Mkt pf1)" and "(trading_strategy pf1)" and
"(∀w ∈ space M. cls_val_process Mkt pf1 0 w = 0)" and
"(AE w in M. 0 ≤ cls_val_process Mkt pf1 m w)"
"0 < 𝒫(w in M. cls_val_process Mkt pf1 m w > 0)" by auto
have ae_eq:"∀w∈ space M. (cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0)"
proof
fix w
assume "w∈ space M"
show "(cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0) "
using assms by simp
qed
have ae_geq:"almost_everywhere M (λw. cls_val_process Mkt pf1 m w ≥ 0) = almost_everywhere M (λw. cls_val_process Mkt pf2 m w ≥ 0)"
proof (rule AE_cong)
fix w
assume "w∈ space M"
show "(cls_val_process Mkt pf1 m w ≥ 0) = (cls_val_process Mkt pf2 m w ≥ 0) "
using assms by simp
qed
have "self_financing Mkt pf2" using assms by simp
moreover have "trading_strategy pf2" using assms by simp
moreover have "(∀w ∈ space M. cls_val_process Mkt pf2 0 w = 0)" using ‹(∀w ∈ space M. cls_val_process Mkt pf1 0 w = 0)› ae_eq by simp
moreover have "AE w in M. 0 ≤ cls_val_process Mkt pf2 m w" using ‹AE w in M. 0 ≤ cls_val_process Mkt pf1 m w› ae_geq by simp
moreover have "0 < prob {w ∈ space M. 0 < cls_val_process Mkt pf2 m w}"
proof -
have "{w ∈ space M. 0 < cls_val_process Mkt pf2 m w} = {w ∈ space M. 0 < cls_val_process Mkt pf1 m w}"
by (simp add: assms(4))
thus ?thesis by (simp add: ‹0 < prob {w ∈ space M. 0 < cls_val_process Mkt pf1 m w}›)
qed
ultimately show ?thesis using arbitrage_processI by blast
qed
definition coincides_on where
"coincides_on Mkt Mkt2 A ⟷ (stocks Mkt = stocks Mkt2 ∧ (∀x. x∈ A ⟶ prices Mkt x = prices Mkt2 x))"
lemma coincides_val_process:
assumes "coincides_on Mkt Mkt2 A"
and "support_set pf ⊆ A"
shows "∀n w. val_process Mkt pf n w = val_process Mkt2 pf n w"
proof (intro allI)
fix n w
show "val_process Mkt pf n w = val_process Mkt2 pf n w"
proof (cases "portfolio pf")
case False
thus ?thesis unfolding val_process_def by simp
next
case True
hence "val_process Mkt pf n w = (∑x∈ support_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms
unfolding val_process_def by simp
also have "... = (∑x∈ support_set pf. prices Mkt2 x n w * pf x (Suc n) w)"
proof (rule sum.cong, simp)
fix y
assume "y∈ support_set pf"
hence "y∈ A" using assms unfolding stock_portfolio_def by auto
hence "prices Mkt y n w = prices Mkt2 y n w" using assms
unfolding coincides_on_def by auto
thus "prices Mkt y n w * pf y (Suc n) w = prices Mkt2 y n w * pf y (Suc n) w" by simp
qed
also have "... = val_process Mkt2 pf n w"
by (metis (mono_tags, lifting) calculation val_process_def)
finally show "val_process Mkt pf n w = val_process Mkt2 pf n w" .
qed
qed
lemma coincides_cls_val_process':
assumes "coincides_on Mkt Mkt2 A"
and "support_set pf ⊆ A"
shows "∀n w. cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
proof (intro allI)
fix n w
show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
proof (cases "portfolio pf")
case False
thus ?thesis unfolding cls_val_process_def by simp
next
case True
hence "cls_val_process Mkt pf (Suc n) w = (∑x∈ support_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms
unfolding cls_val_process_def by simp
also have "... = (∑x∈ support_set pf. prices Mkt2 x (Suc n) w * pf x (Suc n) w)"
proof (rule sum.cong, simp)
fix y
assume "y∈ support_set pf"
hence "y∈ A" using assms unfolding stock_portfolio_def by auto
hence "prices Mkt y (Suc n) w = prices Mkt2 y (Suc n) w" using assms
unfolding coincides_on_def by auto
thus "prices Mkt y (Suc n) w * pf y (Suc n) w = prices Mkt2 y (Suc n) w * pf y (Suc n) w" by simp
qed
also have "... = cls_val_process Mkt2 pf (Suc n) w"
by (metis (mono_tags, lifting) True up_cl_proc.simps(2) cls_val_process_def)
finally show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w" .
qed
qed
lemma coincides_cls_val_process:
assumes "coincides_on Mkt Mkt2 A"
and "support_set pf ⊆ A"
shows "∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
proof (intro allI)
fix n w
show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
proof (cases "portfolio pf")
case False
thus ?thesis unfolding cls_val_process_def by simp
next
case True
show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
proof (induct n)
case 0
with assms show ?case
by (simp add: cls_val_process_def coincides_val_process)
next
case Suc
thus ?case using coincides_cls_val_process' assms by blast
qed
qed
qed
lemma (in disc_filtr_prob_space) coincides_on_self_financing:
assumes "coincides_on Mkt Mkt2 A"
and "support_set p ⊆ A"
and "self_financing Mkt p"
shows "self_financing Mkt2 p"
proof -
have "∀ n w. val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w"
proof (intro allI)
fix n w
have "val_process Mkt2 p (Suc n) w = val_process Mkt p (Suc n) w"
using assms(1) assms(2) coincides_val_process stock_portfolio_def by fastforce
also have "... = cls_val_process Mkt p (Suc n) w" by (metis ‹self_financing Mkt p› self_financing_def)
also have "... = cls_val_process Mkt2 p (Suc n) w"
using assms(1) assms(2) coincides_cls_val_process stock_portfolio_def by blast
finally show "val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w" .
qed
thus "self_financing Mkt2 p" unfolding self_financing_def by auto
qed
lemma (in disc_filtr_prob_space) coincides_on_arbitrage:
assumes "coincides_on Mkt Mkt2 A"
and "support_set p ⊆ A"
and "arbitrage_process Mkt p"
shows "arbitrage_process Mkt2 p"
proof -
have "(∃ m. (self_financing Mkt p) ∧ (trading_strategy p) ∧
(∀w∈ space M. cls_val_process Mkt p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt p m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))" using assms using arbitrage_processE by simp
from this obtain m where "(self_financing Mkt p)" and "(trading_strategy p)" and
"(∀w∈ space M. cls_val_process Mkt p 0 w = 0)" and
"(AE w in M. 0 ≤ cls_val_process Mkt p m w)"
"0 < 𝒫(w in M. cls_val_process Mkt p m w > 0)" by auto
have ae_eq:"∀w∈ space M. (cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0)"
proof
fix w
assume "w∈ space M"
show "(cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0) "
using assms coincides_cls_val_process by (metis)
qed
have ae_geq:"almost_everywhere M (λw. cls_val_process Mkt2 p m w ≥ 0) = almost_everywhere M (λw. cls_val_process Mkt p m w ≥ 0)"
proof (rule AE_cong)
fix w
assume "w∈ space M"
show "(cls_val_process Mkt2 p m w ≥ 0) = (cls_val_process Mkt p m w ≥ 0) "
using assms coincides_cls_val_process by (metis)
qed
have "self_financing Mkt2 p" using assms coincides_on_self_financing
using ‹self_financing Mkt p› by blast
moreover have "trading_strategy p" using ‹trading_strategy p› .
moreover have "(∀w∈ space M. cls_val_process Mkt2 p 0 w = 0)" using ‹(∀w∈ space M. cls_val_process Mkt p 0 w = 0)› ae_eq by simp
moreover have "AE w in M. 0 ≤ cls_val_process Mkt2 p m w" using ‹AE w in M. 0 ≤ cls_val_process Mkt p m w› ae_geq by simp
moreover have "0 < prob {w ∈ space M. 0 < cls_val_process Mkt2 p m w}"
proof -
have "{w ∈ space M. 0 < cls_val_process Mkt2 p m w} = {w ∈ space M. 0 < cls_val_process Mkt p m w}"
by (metis (no_types, lifting) assms(1) assms(2) coincides_cls_val_process)
thus ?thesis by (simp add: ‹0 < prob {w ∈ space M. 0 < cls_val_process Mkt p m w}›)
qed
ultimately show ?thesis using arbitrage_processI by blast
qed
lemma (in disc_filtr_prob_space) coincides_on_stocks_viable:
assumes "coincides_on Mkt Mkt2 (stocks Mkt)"
and "viable_market Mkt"
shows "viable_market Mkt2" using coincides_on_arbitrage
by (metis (mono_tags, hide_lams) assms(1) assms(2) coincides_on_def stock_portfolio_def viable_market_def)
lemma coincides_stocks_val_process:
assumes "stock_portfolio Mkt pf"
and "coincides_on Mkt Mkt2 (stocks Mkt)"
shows "∀n w. val_process Mkt pf n w = val_process Mkt2 pf n w" using assms unfolding stock_portfolio_def
by (simp add: coincides_val_process)
lemma coincides_stocks_cls_val_process:
assumes "stock_portfolio Mkt pf"
and "coincides_on Mkt Mkt2 (stocks Mkt)"
shows "∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms unfolding stock_portfolio_def
by (simp add: coincides_cls_val_process)
lemma (in disc_filtr_prob_space) coincides_on_adapted_val_process:
assumes "coincides_on Mkt Mkt2 A"
and "support_set p ⊆ A"
and "borel_adapt_stoch_proc F (val_process Mkt p)"
shows "borel_adapt_stoch_proc F (val_process Mkt2 p)" unfolding adapt_stoch_proc_def
proof
fix n
have "val_process Mkt p n ∈ borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
moreover have "∀w. val_process Mkt p n w = val_process Mkt2 p n w" using assms coincides_val_process[of Mkt Mkt2 A]
by auto
thus "val_process Mkt2 p n ∈ borel_measurable (F n)"
using calculation by presburger
qed
lemma (in disc_filtr_prob_space) coincides_on_adapted_cls_val_process:
assumes "coincides_on Mkt Mkt2 A"
and "support_set p ⊆ A"
and "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
shows "borel_adapt_stoch_proc F (cls_val_process Mkt2 p)" unfolding adapt_stoch_proc_def
proof
fix n
have "cls_val_process Mkt p n ∈ borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
moreover have "∀w. cls_val_process Mkt p n w = cls_val_process Mkt2 p n w" using assms coincides_cls_val_process[of Mkt Mkt2 A]
by auto
thus "cls_val_process Mkt2 p n ∈ borel_measurable (F n)"
using calculation by presburger
qed
subsubsection ‹Fair prices›
definition (in disc_filtr_prob_space) fair_price where
"fair_price Mkt π pyf matur ⟷
(∃ pr. price_structure pyf matur π pr ∧
(∀ x Mkt2 p. (x∉ stocks Mkt ⟶
((coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p))))"
lemma (in disc_filtr_prob_space) fair_priceI:
assumes "fair_price Mkt π pyf matur"
shows "(∃ pr. price_structure pyf matur π pr ∧
(∀ x. (x∉ stocks Mkt ⟶
(∀ Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p))))" using assms unfolding fair_price_def by simp
paragraph ‹Existence when replicating portfolio›
lemma (in disc_equity_market) replicating_fair_price:
assumes "viable_market Mkt"
and "replicating_portfolio pf der matur"
and "support_adapt Mkt pf"
shows "fair_price Mkt (initial_value pf) der matur"
proof (rule ccontr)
define π where "π = (initial_value pf)"
assume "¬ fair_price Mkt π der matur"
hence imps: "∀pr. (price_structure der matur π pr) ⟶ (∃ x Mkt2 p. (x∉ stocks Mkt ∧
(coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ∧
arbitrage_process Mkt2 p))" unfolding fair_price_def by simp
have "(price_structure der matur π (cls_val_process Mkt pf))" unfolding π_def using replicating_price_process assms by simp
hence "∃ x Mkt2 p. (x∉ stocks Mkt ∧
(coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = (cls_val_process Mkt pf)) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ∧
arbitrage_process Mkt2 p)" using imps by simp
from this obtain x Mkt2 p where "x∉ stocks Mkt" and "coincides_on Mkt Mkt2 (stocks Mkt)" and "prices Mkt2 x = cls_val_process Mkt pf"
and "portfolio p" and "support_set p⊆ stocks Mkt ∪ {x}" and "arbitrage_process Mkt2 p" by auto
have "∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
using coincides_stocks_cls_val_process[of Mkt pf Mkt2] assms ‹coincides_on Mkt Mkt2 (stocks Mkt)› unfolding replicating_portfolio_def
by simp
have "∃m. self_financing Mkt2 p ∧
trading_strategy p ∧
(AE w in M. cls_val_process Mkt2 p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt2 p m w) ∧ 0 < prob {w ∈ space M. 0 < cls_val_process Mkt2 p m w}"
using ‹arbitrage_process Mkt2 p› using arbitrage_processE[of Mkt2] by simp
from this obtain m where "self_financing Mkt2 p"
"trading_strategy p ∧
(AE w in M. cls_val_process Mkt2 p 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt2 p m w) ∧ 0 < prob {w ∈ space M. 0 < cls_val_process Mkt2 p m w}" by auto note mprop = this
define eq_stock where "eq_stock = qty_replace_comp p x pf"
have "∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms unfolding replicating_portfolio_def
using coincides_cls_val_process
using ‹∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w› by blast
hence prx: "∀n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using ‹prices Mkt2 x = cls_val_process Mkt pf› by simp
have "stock_portfolio Mkt2 eq_stock"
by (metis (no_types, lifting) ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹portfolio p› ‹support_set p ⊆ stocks Mkt ∪ {x}›
assms(2) coincides_on_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms eq_stock_def
replace_comp_portfolio replace_comp_stocks stock_portfolio_def)
moreover have "arbitrage_process Mkt2 eq_stock"
proof (rule arbitrage_val_process)
show "arbitrage_process Mkt2 p" using ‹arbitrage_process Mkt2 p› .
show vp: "∀n w. cls_val_process Mkt2 p n w = cls_val_process Mkt2 eq_stock n w" using replace_comp_cls_val_process
‹prices Mkt2 x = cls_val_process Mkt pf› unfolding eq_stock_def
by (metis (no_types, lifting) ‹∀n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w› ‹portfolio p› assms(2) replicating_portfolio_def
stock_portfolio_def)
show "trading_strategy eq_stock"
by (metis ‹arbitrage_process Mkt2 p› arbitrage_process_def assms(2) eq_stock_def
replace_comp_trading_strat replicating_portfolio_def)
show "self_financing Mkt2 eq_stock" unfolding eq_stock_def
proof (rule replace_comp_self_financing)
show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by simp
show "portfolio p" using ‹portfolio p› .
show "∀n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using prx .
show "self_financing Mkt2 p" using ‹self_financing Mkt2 p› .
show "self_financing Mkt2 pf" using coincides_on_self_financing[of Mkt Mkt2 "stocks Mkt" pf]
‹coincides_on Mkt Mkt2 (stocks Mkt)› assms(2) unfolding stock_portfolio_def replicating_portfolio_def by auto
qed
qed
moreover have "viable_market Mkt2" using assms coincides_on_stocks_viable[of Mkt Mkt2]
by (simp add: ‹coincides_on Mkt Mkt2 (stocks Mkt)›)
ultimately show False unfolding viable_market_def by simp
qed
paragraph ‹Uniqueness when replicating portfolio›
text ‹The proof of uniqueness requires the existence of a stock that always takes strictly positive values.›
locale disc_market_pos_stock = disc_equity_market +
fixes pos_stock
assumes in_stock: "pos_stock ∈ stocks Mkt"
and positive: "∀ n w. prices Mkt pos_stock n w > 0"
and readable: "∀ asset∈ stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
lemma (in disc_market_pos_stock) pos_stock_borel_adapted:
shows "borel_adapt_stoch_proc F (prices Mkt pos_stock)"
using assets_def readable in_stock by auto
definition static_quantities where
"static_quantities p ⟷ (∀asset ∈ support_set p. ∃c::real. p asset = (λ n w. c))"
lemma (in disc_filtr_prob_space) static_quantities_trading_strat:
assumes "static_quantities p"
and "finite (support_set p)"
shows "trading_strategy p" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio p" using assms unfolding portfolio_def by simp
fix asset
assume "asset ∈ support_set p"
hence "∃c. p asset = (λ n w. c)" using assms unfolding static_quantities_def by simp
then obtain c where "p asset = (λ n w. c)" by auto
show "borel_predict_stoch_proc F (p asset)" unfolding predict_stoch_proc_def
proof (intro conjI)
show "p asset 0 ∈ borel_measurable (F 0)" using ‹p asset = (λ n w. c)› by simp
show "∀n. p asset (Suc n) ∈ borel_measurable (F n)"
proof
fix n
have "p asset (Suc n) = (λ w. c)" using ‹p asset = (λ n w. c)› by simp
thus "p asset (Suc n) ∈ borel_measurable (F n)" by simp
qed
qed
qed
lemma two_component_support_set:
assumes "∃ n w. a n w ≠ 0"
and "∃ n w. b n w≠ 0"
and "x ≠ y"
shows "support_set ((λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)) = {x,y}"
proof
let ?arb_pf = "(λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)"
have "∃ n w. ?arb_pf x n w ≠ 0" using assms by simp
moreover have "∃n w. ?arb_pf y n w ≠ 0" using assms by simp
ultimately show "{x, y} ⊆ support_set ?arb_pf" unfolding support_set_def by simp
show "support_set ?arb_pf ⊆ {x, y}"
proof (rule ccontr)
assume "¬ support_set ?arb_pf ⊆ {x, y}"
hence "∃z. z∈ support_set ?arb_pf ∧ z∉ {x, y}" by auto
from this obtain z where "z∈ support_set ?arb_pf" and "z∉ {x, y}" by auto
have "∃n w. ?arb_pf z n w ≠ 0" using ‹z∈ support_set ?arb_pf› unfolding support_set_def by simp
from this obtain n w where "?arb_pf z n w ≠ 0" by auto
have "?arb_pf z n w = 0" using ‹z∉ {x, y}› by simp
thus False using ‹?arb_pf z n w ≠ 0› by simp
qed
qed
lemma two_component_val_process:
assumes "arb_pf = ((λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b))"
and "portfolio arb_pf"
and "x ≠ y"
and "∃ n w. a n w ≠ 0"
and "∃ n w. b n w≠ 0"
shows "val_process Mkt arb_pf n w =
prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w"
proof -
have "support_set arb_pf = {x,y}" using assms by (simp add:two_component_support_set)
have "val_process Mkt arb_pf n w = (∑x∈support_set arb_pf. prices Mkt x n w * arb_pf x (Suc n) w)"
unfolding val_process_def using ‹portfolio arb_pf› by simp
also have "... = (∑x∈{x, y}. prices Mkt x n w * arb_pf x (Suc n) w)" using ‹support_set arb_pf = {x, y}›
by simp
also have "... = (∑x∈{y}. prices Mkt x n w * arb_pf x (Suc n) w) + prices Mkt x n w * arb_pf x (Suc n) w"
using sum.insert[of "{y}" x "λx. prices Mkt x n w * arb_pf x n w"] assms(3) by auto
also have "... = prices Mkt y n w * arb_pf y (Suc n) w + prices Mkt x n w * arb_pf x (Suc n) w" by simp
also have "... = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" using assms by auto
finally show "val_process Mkt arb_pf n w = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" .
qed
lemma quantity_update_support_set:
assumes "∃n w. pr n w ≠ 0"
and "x∉ support_set p"
shows "support_set (p(x:=pr)) = support_set p ∪ {x}"
proof
show "support_set (p(x := pr)) ⊆ support_set p ∪ {x}"
proof
fix y
assume "y∈ support_set (p(x := pr))"
show "y ∈ support_set p ∪ {x}"
proof (rule ccontr)
assume "¬y ∈ support_set p ∪ {x}"
hence "y ≠ x" by simp
have "∃n w. (p(x := pr)) y n w ≠ 0" using ‹y∈ support_set (p(x := pr))› unfolding support_set_def by simp
then obtain n w where nwprop: "(p(x := pr)) y n w ≠ 0" by auto
have "y∉ support_set p" using ‹¬y ∈ support_set p ∪ {x}› by simp
hence "y = x" using nwprop using support_set_def by force
thus False using ‹y≠ x› by simp
qed
qed
show "support_set p ∪ {x} ⊆ support_set (p(x := pr))"
proof
fix y
assume "y ∈ support_set p ∪ {x}"
show "y∈ support_set (p(x := pr))"
proof (cases "y∈ support_set p")
case True
thus ?thesis
proof -
have f1: "y ∈ {b. ∃n a. p b n a ≠ 0}"
by (metis True support_set_def)
then have "y ≠ x"
using assms(2) support_set_def by force
then show ?thesis
using f1 by (simp add: support_set_def)
qed
next
case False
hence "y = x" using ‹y ∈ support_set p ∪ {x}› by auto
thus ?thesis using assms by (simp add: support_set_def)
qed
qed
qed
lemma fix_asset_price:
shows "∃x Mkt2. x ∉ stocks Mkt ∧
coincides_on Mkt Mkt2 (stocks Mkt) ∧
prices Mkt2 x = pr"
proof -
have "∃x. x∉ stocks Mkt" by (metis UNIV_eq_I stk_strict_subs_def mkt_stocks_assets)
from this obtain x where "x∉ stocks Mkt" by auto
let ?res = "discrete_market_of (stocks Mkt) ((prices Mkt)(x:=pr))"
have "coincides_on Mkt ?res (stocks Mkt)"
proof -
have "stocks Mkt = stocks (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr)))"
by (metis (no_types) stk_strict_subs_def mkt_stocks_assets stocks_of)
then show ?thesis
by (simp add: ‹x ∉ stocks Mkt› coincides_on_def prices_of)
qed
have "prices ?res x = pr" by (simp add: prices_of)
show ?thesis
using ‹coincides_on Mkt (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) (stocks Mkt)› ‹prices (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) x = pr› ‹x ∉ stocks Mkt› by blast
qed
lemma (in disc_market_pos_stock) arbitrage_portfolio_properties:
assumes "price_structure der matur π pr"
and "replicating_portfolio pf der matur"
and "(coincides_on Mkt Mkt2 (stocks Mkt))"
and "(prices Mkt2 x = pr)"
and "x∉ stocks Mkt"
and "diff_inv = (π - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
and "diff_inv ≠ 0"
and "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
and "contr_pf = qty_sum arb_pf pf"
shows "self_financing Mkt2 contr_pf"
and "trading_strategy contr_pf"
and "∀w∈ space M. cls_val_process Mkt2 contr_pf 0 w = 0"
and "0 < diff_inv ⟶ (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
and "diff_inv < 0 ⟶ (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
and "support_set arb_pf = {x, pos_stock}"
and "portfolio contr_pf"
proof -
have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
proof -
have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
hence "∃c. ∀w∈space M. prices Mkt pos_stock 0 w = c" using adapted_init[of "prices Mkt pos_stock"] by simp
moreover have "∀w∈ space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
ultimately show ?thesis using constant_image_pos by simp
qed
show "support_set arb_pf = {x, pos_stock}"
proof -
have "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
using ‹arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))› .
moreover have "∃n w. diff_inv ≠ 0" using assms by simp
moreover have "x≠ pos_stock" using ‹x ∉ stocks Mkt› in_stock by auto
ultimately show ?thesis by (simp add:two_component_support_set)
qed
hence "portfolio arb_pf" unfolding portfolio_def by simp
have arb_vp:"∀n w. val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w"
proof (intro allI)
fix n w
have "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * (λ n w. diff_inv) n w + prices Mkt2 x n w * (λ n w. -1) n w"
proof (rule two_component_val_process)
show "x≠ pos_stock" using ‹x ∉ stocks Mkt› in_stock by auto
show "arb_pf = (λx n w. 0)(x := λa b. - 1, pos_stock := λa b. diff_inv)" using assms by simp
show "portfolio arb_pf" using ‹portfolio arb_pf› by simp
show "∃n w. - (1::real) ≠ 0" by simp
show "∃n w. diff_inv ≠ 0" using assms by auto
qed
also have "... = prices Mkt2 pos_stock n w * diff_inv - pr n w" using ‹prices Mkt2 x = pr› by simp
finally show "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" .
qed
have "static_quantities arb_pf" unfolding static_quantities_def
proof
fix asset
assume "asset ∈ support_set arb_pf"
thus "∃c. arb_pf asset = (λn w. c)"
proof (cases "asset = x")
case True
thus ?thesis using assms by auto
next
case False
hence "asset = pos_stock" using ‹support_set arb_pf = {x, pos_stock}›
using ‹asset ∈ support_set arb_pf› by blast
thus ?thesis using assms by auto
qed
qed
hence "trading_strategy arb_pf"
using ‹portfolio arb_pf› portfolio_def static_quantities_trading_strat by blast
have "self_financing Mkt2 arb_pf"
by (simp add: static_portfolio_self_financing ‹arb_pf = (λx n w. 0) (x := λn w. -1, pos_stock := λn w. diff_inv)›)
hence arb_uvp: "∀n w. cls_val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" using assms arb_vp
by (simp add:self_financingE)
show "portfolio contr_pf" using assms
by (metis ‹support_set arb_pf = {x, pos_stock}› replicating_portfolio_def
finite.emptyI finite.insertI portfolio_def stock_portfolio_def sum_portfolio)
have "support_set contr_pf ⊆ stocks Mkt ∪ {x}"
proof -
have "support_set contr_pf ⊆ support_set arb_pf ∪ support_set pf" using assms
by (simp add:sum_support_set)
moreover have "support_set arb_pf ⊆ stocks Mkt ∪ {x}" using ‹support_set arb_pf = {x, pos_stock}› in_stock by simp
moreover have "support_set pf ⊆ stocks Mkt ∪ {x}" using assms unfolding replicating_portfolio_def
stock_portfolio_def by auto
ultimately show ?thesis by auto
qed
show "self_financing Mkt2 contr_pf"
proof -
have "self_financing Mkt2 (qty_sum arb_pf pf)"
proof (rule sum_self_financing)
show "portfolio arb_pf" using ‹support_set arb_pf = {x, pos_stock}› unfolding portfolio_def by auto
show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by auto
show "self_financing Mkt2 pf" using coincides_on_self_financing
‹(coincides_on Mkt Mkt2 (stocks Mkt))› ‹(prices Mkt2 x = pr)› assms(2)
unfolding replicating_portfolio_def stock_portfolio_def by blast
show "self_financing Mkt2 arb_pf"
by (simp add: static_portfolio_self_financing ‹arb_pf = (λx n w. 0) (x := λn w. -1, pos_stock := λn w. diff_inv)›)
qed
thus ?thesis using assms by simp
qed
show "trading_strategy contr_pf"
proof -
have "trading_strategy (qty_sum arb_pf pf)"
proof (rule sum_trading_strat)
show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
show "trading_strategy arb_pf" using ‹trading_strategy arb_pf› .
qed
thus ?thesis using assms by simp
qed
show "∀w∈ space M. cls_val_process Mkt2 contr_pf 0 w = 0"
proof
fix w
assume "w∈ space M"
have "cls_val_process Mkt2 contr_pf 0 w = cls_val_process Mkt2 arb_pf 0 w + cls_val_process Mkt2 pf 0 w"
using sum_cls_val_process0[of arb_pf pf Mkt2]
using ‹portfolio arb_pf› assms replicating_portfolio_def stock_portfolio_def by blast
also have "... = prices Mkt2 pos_stock 0 w * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w" using arb_uvp by simp
also have "... = constant_image (prices Mkt pos_stock 0) * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w"
proof -
have f1: "prices Mkt pos_stock = prices Mkt2 pos_stock"
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› in_stock unfolding coincides_on_def by blast
have "prices Mkt pos_stock 0 w = constant_image (prices Mkt pos_stock 0)"
using ‹w ∈ space M› adapted_init constant_imageI pos_stock_borel_adapted by blast
then show ?thesis
using f1 by simp
qed
also have "... = (π - initial_value pf) - pr 0 w + cls_val_process Mkt2 pf 0 w"
using ‹0 < constant_image (prices Mkt pos_stock 0)› assms by simp
also have "... = (π - initial_value pf) - π + cls_val_process Mkt2 pf 0 w" using ‹price_structure der matur π pr›
price_structure_init[of der matur π pr] by (simp add: ‹w ∈ space M›)
also have "... = (π - initial_value pf) - π + (initial_value pf)" using initial_valueI assms unfolding replicating_portfolio_def
using ‹w ∈ space M› coincides_stocks_cls_val_process self_financingE readable
by (metis (no_types, hide_lams) support_adapt_def stock_portfolio_def subsetCE)
also have "... = 0" by simp
finally show "cls_val_process Mkt2 contr_pf 0 w = 0" .
qed
show "0 < diff_inv ⟶ (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
proof
assume "0 < diff_inv"
show "AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w"
proof (rule AE_mp)
have "AE w in M. prices Mkt2 x matur w = der w" using ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
unfolding price_structure_def by auto
moreover have "AE w in M. cls_val_process Mkt2 pf matur w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
‹coincides_on Mkt Mkt2 (stocks Mkt)› unfolding replicating_portfolio_def by auto
ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w ⟶ 0 < cls_val_process Mkt2 contr_pf matur w"
proof (rule AE_I2, rule impI)
fix w
assume "w∈ space M"
and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
using sum_cls_val_process[of arb_pf pf Mkt2]
‹portfolio arb_pf› assms replicating_portfolio_def stock_portfolio_def by blast
also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
using arb_uvp by simp
also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
using ‹prices Mkt2 x = pr› by simp
also have "... = prices Mkt2 pos_stock matur w * diff_inv" using ‹prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w›
by simp
also have "... > 0" using positive ‹0 < diff_inv›
by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt)› coincides_on_def in_stock mult_pos_pos)
finally have "cls_val_process Mkt2 contr_pf matur w > 0".
thus "0 < cls_val_process Mkt2 contr_pf matur w" by simp
qed
qed
qed
show "diff_inv < 0 ⟶ (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
proof
assume "diff_inv < 0"
show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w"
proof (rule AE_mp)
have "AE w in M. prices Mkt2 x matur w = der w" using ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
unfolding price_structure_def by auto
moreover have "AE w in M. cls_val_process Mkt2 pf matur w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
‹coincides_on Mkt Mkt2 (stocks Mkt)› unfolding replicating_portfolio_def by auto
ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w ⟶ 0 > cls_val_process Mkt2 contr_pf matur w"
proof (rule AE_I2, rule impI)
fix w
assume "w∈ space M"
and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
using sum_cls_val_process[of arb_pf pf Mkt2]
‹portfolio arb_pf› assms replicating_portfolio_def stock_portfolio_def by blast
also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
using arb_uvp by simp
also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
using ‹prices Mkt2 x = pr› by simp
also have "... = prices Mkt2 pos_stock matur w * diff_inv" using ‹prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w›
by simp
also have "... < 0" using positive ‹diff_inv < 0›
by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt)› coincides_on_def in_stock mult_pos_neg)
finally have "cls_val_process Mkt2 contr_pf matur w < 0".
thus "0 > cls_val_process Mkt2 contr_pf matur w" by simp
qed
qed
qed
qed
lemma (in disc_equity_market) mult_comp_cls_val_process_measurable':
assumes "cls_val_process Mkt2 pf n ∈borel_measurable (F n)"
and "portfolio pf"
and "qty n ∈ borel_measurable (F n)"
and "0 ≠ n"
shows "cls_val_process Mkt2 (qty_mult_comp pf qty) n ∈ borel_measurable (F n)"
proof -
have "∃m. n = Suc m" using assms by presburger
from this obtain m where "n = Suc m" by auto
hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m) ∈ borel_measurable (F (Suc m))"
using mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
assms ‹n= Suc m› by presburger
thus ?thesis using ‹n = Suc m› by simp
qed
lemma (in disc_equity_market) mult_comp_cls_val_process_measurable:
assumes "∀n. cls_val_process Mkt2 pf n ∈borel_measurable (F n)"
and "portfolio pf"
and "∀n. qty (Suc n) ∈ borel_measurable (F n)"
shows "∀n. cls_val_process Mkt2 (qty_mult_comp pf qty) n ∈ borel_measurable (F n)"
proof
fix n
show "cls_val_process Mkt2 (qty_mult_comp pf qty) n ∈ borel_measurable (F n)"
proof (cases "n=0")
case False
hence "∃m. n = Suc m" by presburger
from this obtain m where "n = Suc m" by auto
have "qty n ∈ borel_measurable (F n)"
using Suc_n_not_le_n ‹n = Suc m› assms(3) increasing_measurable_info nat_le_linear by blast
hence "qty (Suc m) ∈ borel_measurable (F (Suc m))" using ‹n = Suc m› by simp
hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m) ∈ borel_measurable (F (Suc m))"
using mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
assms ‹n= Suc m› by presburger
thus ?thesis using ‹n = Suc m› by simp
next
case True
have "qty (Suc 0) ∈ borel_measurable (F 0)" using assms by simp
moreover have "cls_val_process Mkt2 pf 0 ∈ borel_measurable (F 0)" using assms by simp
ultimately have "(λw. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w) ∈ borel_measurable (F 0)" by simp
thus ?thesis using assms(2) True mult_comp_cls_val_process0
by (simp add: ‹(λw. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w) ∈ borel_measurable (F 0)› mult_comp_cls_val_process0 measurable_cong)
qed
qed
lemma (in disc_equity_market) mult_comp_val_process_measurable:
assumes "val_process Mkt2 pf n ∈borel_measurable (F n)"
and "portfolio pf"
and "qty (Suc n) ∈ borel_measurable (F n)"
shows "val_process Mkt2 (qty_mult_comp pf qty) n ∈ borel_measurable (F n)"
using mult_comp_val_process[of pf Mkt2 qty] borel_measurable_times[of "val_process Mkt2 pf n" "F n" "qty (Suc n)"]
assms by presburger
lemma (in disc_market_pos_stock) repl_fair_price_unique:
assumes "replicating_portfolio pf der matur"
and "fair_price Mkt π der matur"
shows "π = initial_value pf"
proof -
have expr: "(∃ pr. price_structure der matur π pr ∧
(∀ x. (x∉ stocks Mkt ⟶
(∀ Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p))))" using assms fair_priceI by simp
then obtain pr where "price_structure der matur π pr" and
xasset: "(∀ x. (x∉ stocks Mkt ⟶
(∀ Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p)))" by auto
define diff_inv where "diff_inv = (π - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
{
fix x
assume "x∉ stocks Mkt"
hence mkprop: "(∀ Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p)" using xasset by simp
fix Mkt2
assume "(coincides_on Mkt Mkt2 (stocks Mkt))" and "(prices Mkt2 x = pr)"
have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
proof -
have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
hence "∃c. ∀w∈space M. prices Mkt pos_stock 0 w = c" using adapted_init[of "prices Mkt pos_stock"] by simp
moreover have "∀w∈ space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
ultimately show ?thesis using constant_image_pos by simp
qed
define arb_pf where "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
define contr_pf where "contr_pf = qty_sum arb_pf pf"
have 1:"0 ≠ diff_inv ⟶ self_financing Mkt2 contr_pf"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 2:"0 ≠ diff_inv ⟶ trading_strategy contr_pf"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 3:"0 ≠ diff_inv ⟶ (∀w∈ space M. cls_val_process Mkt2 contr_pf 0 w = 0)"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 4: "0 < diff_inv ⟶ (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 5: "diff_inv < 0 ⟶ (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 6: "0 ≠ diff_inv ⟶ support_set arb_pf = {x, pos_stock}"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 7: "0 ≠ diff_inv ⟶support_set contr_pf ⊆ stocks Mkt ∪ {x}"
proof -
have "0 ≠ diff_inv ⟶ support_set contr_pf ⊆ support_set arb_pf ∪ support_set pf" unfolding contr_pf_def
by (simp add:sum_support_set)
moreover have "0 ≠ diff_inv ⟶support_set arb_pf ⊆ stocks Mkt ∪ {x}" using ‹0 ≠ diff_inv ⟶ support_set arb_pf = {x, pos_stock}› in_stock by simp
moreover have "0 ≠ diff_inv ⟶support_set pf ⊆ stocks Mkt ∪ {x}" using assms unfolding replicating_portfolio_def
stock_portfolio_def by auto
ultimately show ?thesis by auto
qed
have 8:"0 ≠ diff_inv ⟶portfolio contr_pf"
using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹price_structure der matur π pr› ‹prices Mkt2 x = pr›
‹x ∉ stocks Mkt› arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
have 9: "0 ≠ diff_inv ⟶ cls_val_process Mkt2 contr_pf matur ∈ borel_measurable (F matur)"
proof
assume "0 ≠ diff_inv"
have 10:"∀ asset ∈ support_set arb_pf ∪ support_set pf. prices Mkt2 asset matur ∈ borel_measurable (F matur)"
proof
fix asset
assume "asset ∈ support_set arb_pf ∪ support_set pf"
show "prices Mkt2 asset matur ∈ borel_measurable (F matur)"
proof (cases "asset ∈ support_set pf")
case True
thus ?thesis using assms readable
by (metis (no_types, lifting) ‹coincides_on Mkt Mkt2 (stocks Mkt)› adapt_stoch_proc_def
coincides_on_def disc_equity_market.replicating_portfolio_def
disc_equity_market_axioms stock_portfolio_def subsetCE)
next
case False
hence "asset∈ support_set arb_pf" using ‹asset ∈ support_set arb_pf ∪ support_set pf› by auto
show ?thesis
proof (cases "asset = x")
case True
thus ?thesis
using ‹price_structure der matur π pr› ‹prices Mkt2 x = pr› price_structure_borel_measurable by blast
next
case False
hence "asset = pos_stock" using ‹asset∈ support_set arb_pf› ‹0 ≠ diff_inv ⟶ support_set arb_pf = {x, pos_stock}›
‹0 ≠ diff_inv› by auto
thus ?thesis
by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt)› adapt_stoch_proc_def coincides_on_def in_stock pos_stock_borel_adapted)
qed
qed
qed
moreover have "∀asset∈support_set contr_pf. contr_pf asset matur ∈ borel_measurable (F matur)"
using ‹0 ≠ diff_inv ⟶trading_strategy contr_pf› ‹0 ≠ diff_inv›
by (metis adapt_stoch_proc_def disc_filtr_prob_space.predict_imp_adapt disc_filtr_prob_space_axioms trading_strategy_def)
ultimately show "cls_val_process Mkt2 contr_pf matur ∈ borel_measurable (F matur)"
proof-
have "∀asset∈support_set contr_pf. contr_pf asset (Suc matur) ∈ borel_measurable (F matur)"
using ‹0 ≠ diff_inv ⟶trading_strategy contr_pf› ‹0 ≠ diff_inv›
by (simp add: predict_stoch_proc_def trading_strategy_def)
moreover have "∀asset∈support_set contr_pf. prices Mkt2 asset matur ∈ borel_measurable (F matur)" using 10 unfolding contr_pf_def
using sum_support_set[of arb_pf pf] by auto
ultimately show ?thesis by (metis (no_types, lifting) "1" ‹0 ≠ diff_inv› quantity_adapted self_financingE)
qed
qed
{
assume "0 > diff_inv"
define opp_pf where "opp_pf = qty_mult_comp contr_pf (λ n w. -1)"
have "arbitrage_process Mkt2 opp_pf"
proof (rule arbitrage_processI, rule exI, intro conjI)
show "self_financing Mkt2 opp_pf" using 1 ‹0 > diff_inv› mult_time_constant_self_financing[of contr_pf] 8
unfolding opp_pf_def by auto
show "trading_strategy opp_pf" unfolding opp_pf_def
proof (rule mult_comp_trading_strat)
show "trading_strategy contr_pf" using 2 ‹0 > diff_inv› by auto
show "borel_predict_stoch_proc F (λn w. - 1)" by (simp add: constant_process_borel_predictable)
qed
show "∀w∈space M. cls_val_process Mkt2 opp_pf 0 w = 0"
proof
fix w
assume "w∈ space M"
show "cls_val_process Mkt2 opp_pf 0 w = 0" using 3 8 ‹0 > diff_inv›
using ‹w ∈ space M› mult_comp_cls_val_process0 opp_pf_def by fastforce
qed
have "AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w"
proof (rule AE_mp)
show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w" using 5 ‹0 > diff_inv› by auto
show "AE w in M. cls_val_process Mkt2 contr_pf matur w < 0 ⟶ 0 < cls_val_process Mkt2 opp_pf matur w"
proof
fix w
assume "w∈ space M"
show "cls_val_process Mkt2 contr_pf matur w < 0 ⟶ 0 < cls_val_process Mkt2 opp_pf matur w"
proof
assume "cls_val_process Mkt2 contr_pf matur w < 0"
show "0 < cls_val_process Mkt2 opp_pf matur w"
proof (cases "matur = 0")
case False
hence "∃m. Suc m = matur" by presburger
from this obtain m where "Suc m = matur" by auto
hence "0 < cls_val_process Mkt2 opp_pf (Suc m) w" using 3 8 ‹0 > diff_inv› ‹w ∈ space M› mult_comp_cls_val_process_Suc opp_pf_def
using ‹cls_val_process Mkt2 contr_pf matur w < 0› by fastforce
thus ?thesis using ‹Suc m = matur› by simp
next
case True
thus ?thesis using 3 8 ‹0 > diff_inv› ‹w ∈ space M› mult_comp_cls_val_process0 opp_pf_def
using ‹cls_val_process Mkt2 contr_pf matur w < 0› by auto
qed
qed
qed
qed
thus "AE w in M. 0 ≤ cls_val_process Mkt2 opp_pf matur w" by auto
show "0 < prob {w ∈ space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
proof -
let ?P = "{w∈ space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
have "cls_val_process Mkt2 opp_pf matur ∈ borel_measurable (F matur)"
proof -
have "cls_val_process Mkt2 contr_pf matur ∈ borel_measurable (F matur)" using 9 ‹0 > diff_inv› by simp
moreover have "portfolio contr_pf" using 8 ‹0 > diff_inv› by simp
moreover have "(λw. - 1) ∈ borel_measurable (F matur)" by (simp add:constant_process_borel_adapted)
ultimately show ?thesis
using mult_comp_cls_val_process_measurable
proof -
have "diff_inv ≠ 0"
using ‹diff_inv < 0› by blast
then have "self_financing Mkt2 contr_pf"
by (metis "1")
then show ?thesis
by (metis (no_types) ‹(λw. - 1) ∈ borel_measurable (F matur)› ‹portfolio contr_pf›
‹self_financing Mkt2 opp_pf› ‹cls_val_process Mkt2 contr_pf matur ∈ borel_measurable (F matur)›
mult_comp_val_process_measurable opp_pf_def self_financingE)
qed
qed
moreover have "space M = space (F matur)"
using filtration by (simp add: filtration_def subalgebra_def)
ultimately have "?P ∈ sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
by auto
hence "?P ∈ sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
hence "measure M ?P = 1" using prob_Collect_eq_1[of "λx. 0 < cls_val_process Mkt2 opp_pf matur x"]
‹AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w› ‹0 > diff_inv› by blast
thus ?thesis by simp
qed
qed
have "∃ p. portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ∧ arbitrage_process Mkt2 p"
proof(intro exI conjI)
show "arbitrage_process Mkt2 opp_pf" using ‹arbitrage_process Mkt2 opp_pf› .
show "portfolio opp_pf" unfolding opp_pf_def using 8 ‹0 > diff_inv› by (auto simp add: mult_comp_portfolio)
show "support_set opp_pf ⊆ stocks Mkt ∪ {x}" unfolding opp_pf_def using 7 ‹0 > diff_inv›
using mult_comp_support_set by fastforce
qed
} note negp = this
{
assume "0 < diff_inv"
have "arbitrage_process Mkt2 contr_pf"
proof (rule arbitrage_processI, rule exI, intro conjI)
show "self_financing Mkt2 contr_pf" using 1 ‹0 < diff_inv› by auto
show "trading_strategy contr_pf" using 2 ‹0 < diff_inv› by auto
show "∀w∈space M. cls_val_process Mkt2 contr_pf 0 w = 0" using 3 ‹0 < diff_inv› by auto
show "AE w in M. 0 ≤ cls_val_process Mkt2 contr_pf matur w" using 4 ‹0 < diff_inv› by auto
show "0 < prob {w ∈ space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
proof -
let ?P = "{w∈ space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
have "cls_val_process Mkt2 contr_pf matur ∈ borel_measurable (F matur)" using 9 ‹0 < diff_inv› by auto
moreover have "space M = space (F matur)"
using filtration by (simp add: filtration_def subalgebra_def)
ultimately have "?P ∈ sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
by auto
hence "?P ∈ sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
hence "measure M ?P = 1" using prob_Collect_eq_1[of "λx. 0 < cls_val_process Mkt2 contr_pf matur x"]
4 ‹0 < diff_inv› by blast
thus ?thesis by simp
qed
qed
have "∃ p. portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ∧ arbitrage_process Mkt2 p"
proof(intro exI conjI)
show "arbitrage_process Mkt2 contr_pf" using ‹arbitrage_process Mkt2 contr_pf› .
show "portfolio contr_pf" using 8 ‹0 < diff_inv› by auto
show "support_set contr_pf ⊆ stocks Mkt ∪ {x}" using 7 ‹0 < diff_inv› by auto
qed
} note posp = this
have "diff_inv ≠ 0 ⟶ ¬(∃ pr. price_structure der matur π pr ∧
(∀ x. (x∉ stocks Mkt ⟶
(∀ Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt)) ∧ (prices Mkt2 x = pr) ∧ portfolio p ∧ support_set p ⊆ stocks Mkt ∪ {x} ⟶
¬ arbitrage_process Mkt2 p))))"
using ‹coincides_on Mkt Mkt2 (stocks Mkt)› ‹prices Mkt2 x = pr› ‹x ∉ stocks Mkt› xasset posp negp by force
}
hence "diff_inv = 0" using fix_asset_price expr by metis
moreover have "constant_image (prices Mkt pos_stock 0) > 0"
by (simp add: adapted_init constant_image_pos pos_stock_borel_adapted positive)
ultimately show ?thesis unfolding diff_inv_def by auto
qed
subsection ‹Risk-neutral probability space›
subsubsection ‹risk-free rate and discount factor processes›
fun disc_rfr_proc:: "real ⇒ nat ⇒ 'a ⇒ real"
where
rfr_base: "(disc_rfr_proc r) 0 w = 1"|
rfr_step: "(disc_rfr_proc r) (Suc n) w = (1+r) * (disc_rfr_proc r) n w"
lemma disc_rfr_proc_borel_measurable:
shows "(disc_rfr_proc r) n ∈ borel_measurable M"
proof (induct n)
case (Suc n) thus ?case by (simp add:borel_measurable_times)
qed auto
lemma disc_rfr_proc_nonrandom:
fixes r::real
shows "⋀n. disc_rfr_proc r n ∈ borel_measurable (F 0)" using disc_rfr_proc_borel_measurable by auto
lemma (in disc_equity_market) disc_rfr_constant_time:
shows "∃c. ∀w ∈ space (F 0). (disc_rfr_proc r n) w = c"
proof (rule triv_measurable_cst)
show "space (F 0) = space M" using filtration by (simp add:filtration_def subalgebra_def)
show "sets (F 0) = {{}, space M}" using info_disc_filtr by (simp add: bot_nat_def init_triv_filt_def)
show "(disc_rfr_proc r n) ∈ borel_measurable (F 0)" using disc_rfr_proc_nonrandom by blast
show "space M ≠ {}" by (simp add:not_empty)
qed
lemma (in disc_filtr_prob_space) disc_rfr_proc_borel_adapted:
shows "borel_adapt_stoch_proc F (disc_rfr_proc r)"
unfolding adapt_stoch_proc_def using disc_rfr_proc_nonrandom
filtration unfolding filtration_def
by (meson increasing_measurable_info le0)
lemma disc_rfr_proc_positive:
assumes "-1 < r"
shows "⋀n w . 0 < disc_rfr_proc r n w"
proof -
fix n
fix w::'a
show "0 < disc_rfr_proc r n w"
proof (induct n)
case 0 thus ?case using assms "disc_rfr_proc.simps" by simp
next
case (Suc n) thus ?case using assms "disc_rfr_proc.simps" by simp
qed
qed
lemma (in prob_space) disc_rfr_constant_time_pos:
assumes "-1 < r"
shows "∃c > 0. ∀w ∈ space M. (disc_rfr_proc r n) w = c"
proof -
let ?F = "sigma (space M) {{}, space M}"
have ex: "∃c. ∀w ∈ space ?F. (disc_rfr_proc r n) w = c"
proof (rule triv_measurable_cst)
show "space ?F = space M" by simp
show "sets ?F = {{}, space M}" by (meson sigma_algebra.sets_measure_of_eq sigma_algebra_trivial)
show "(disc_rfr_proc r n) ∈ borel_measurable ?F" using disc_rfr_proc_borel_measurable by blast
show "space M ≠ {}" by (simp add:not_empty)
qed
from this obtain c where "∀w ∈ space ?F. (disc_rfr_proc r n) w = c" by auto note cprops = this
have "c>0"
proof -
have "∃ w. w∈ space M" using subprob_not_empty by blast
from this obtain w where "w∈ space M" by auto
hence "c = disc_rfr_proc r n w" using cprops by simp
also have "... > 0" using disc_rfr_proc_positive[of r n] assms by simp
finally show ?thesis .
qed
moreover have "space M = space ?F" by simp
ultimately show ?thesis using ex using cprops by blast
qed
lemma disc_rfr_proc_Suc_div:
assumes "-1 < r"
shows "⋀w. disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
proof -
fix w::'a
show "disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
using disc_rfr_proc_positive assms by (metis rfr_step less_irrefl nonzero_eq_divide_eq)
qed
definition discount_factor where
"discount_factor r n = (λw. inverse (disc_rfr_proc r n w))"
lemma discount_factor_times_rfr:
assumes "-1 < r"
shows "(1+r) * discount_factor r (Suc n) w = discount_factor r n w" unfolding discount_factor_def using assms by simp
lemma discount_factor_borel_measurable:
shows "discount_factor r n ∈ borel_measurable M" unfolding discount_factor_def
proof (rule borel_measurable_inverse)
show "disc_rfr_proc r n ∈ borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
qed
lemma discount_factor_init:
shows "discount_factor r 0 = (λw. 1)" unfolding discount_factor_def by simp
lemma discount_factor_nonrandom:
shows "discount_factor r n ∈ borel_measurable M" unfolding discount_factor_def
proof (rule borel_measurable_inverse)
show "disc_rfr_proc r n ∈ borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
qed
lemma discount_factor_positive:
assumes "-1 < r"
shows "⋀n w . 0 < discount_factor r n w" using assms disc_rfr_proc_positive unfolding discount_factor_def by auto
lemma (in prob_space) discount_factor_constant_time_pos:
assumes "-1 < r"
shows "∃c > 0. ∀w ∈ space M. (discount_factor r n) w = c" using disc_rfr_constant_time_pos unfolding discount_factor_def
by (metis assms inverse_positive_iff_positive)
locale rsk_free_asset =
fixes Mkt r risk_free_asset
assumes acceptable_rate: "-1 < r"
and rf_price: "prices Mkt risk_free_asset = disc_rfr_proc r"
and rf_stock: "risk_free_asset ∈ stocks Mkt"
locale rfr_disc_equity_market = disc_equity_market + rsk_free_asset +
assumes rd: "∀ asset∈ stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
sublocale rfr_disc_equity_market ⊆ disc_market_pos_stock _ _ _ "risk_free_asset"
by (unfold_locales, (auto simp add: rf_stock rd disc_rfr_proc_positive rf_price acceptable_rate))
subsubsection ‹Discounted value of a stochastic process›
definition discounted_value where
"discounted_value r X = (λ n w. discount_factor r n w * X n w)"
lemma (in rfr_disc_equity_market) discounted_rfr:
shows "discounted_value r (prices Mkt risk_free_asset) n w = 1" unfolding discounted_value_def discount_factor_def
using rf_price by (metis less_irrefl mult.commute positive right_inverse)
lemma discounted_init:
shows "∀w. discounted_value r X 0 w = X 0 w" unfolding discounted_value_def by (simp add: discount_factor_init)
lemma discounted_mult:
shows "∀n w. discounted_value r (λm x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
by (simp add: discounted_value_def)
lemma discounted_mult':
shows "discounted_value r (λm x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
by (simp add: discounted_value_def)
lemma discounted_mult_times_rfr:
assumes "-1 < r"
shows "discounted_value r (λm w. (1+r) * X w) (Suc n) w = discounted_value r (λm w. X w) n w"
unfolding discounted_value_def using assms discount_factor_times_rfr discounted_mult
by (simp add: discount_factor_times_rfr mult.commute)
lemma discounted_cong:
assumes "∀n w. X n w = Y n w"
shows "∀ n w. discounted_value r X n w = discounted_value r Y n w"
by (simp add: assms discounted_value_def)
lemma discounted_cong':
assumes "X n w = Y n w"
shows "discounted_value r X n w = discounted_value r Y n w"
by (simp add: assms discounted_value_def)
lemma discounted_AE_cong:
assumes "AE w in N. X n w = Y n w"
shows "AE w in N. discounted_value r X n w = discounted_value r Y n w"
proof (rule AE_mp)
show "AE w in N. X n w = Y n w" using assms by simp
show "AE w in N. X n w = Y n w ⟶ discounted_value r X n w = discounted_value r Y n w"
proof
fix w
assume "w∈ space N"
thus "X n w = Y n w ⟶ discounted_value r X n w = discounted_value r Y n w " by (simp add:discounted_value_def)
qed
qed
lemma discounted_sum:
assumes "finite I"
shows "∀n w. (∑ i∈ I. (discounted_value r (λm x. f i m x)) n w) = (discounted_value r (λm x. (∑i∈ I. f i m x)) n w)"
using assms(1) subset_refl[of I]
proof (induct rule: finite_subset_induct)
case empty
then show ?case
by (simp add: discounted_value_def)
next
case (insert a F)
show ?case
proof (intro allI)
fix n w
have "(∑i∈insert a F. discounted_value r (f i) n w) = discounted_value r (f a) n w + (∑i∈F. discounted_value r (f i) n w)"
by (simp add: insert.hyps(1) insert.hyps(3))
also have "... = discounted_value r (f a) n w + discounted_value r (λm x. ∑i∈F. f i m x) n w" using insert.hyps(4) by simp
also have "... = discounted_value r (λm x. ∑i∈insert a F. f i m x) n w"
by (simp add: discounted_value_def insert.hyps(1) insert.hyps(3) ring_class.ring_distribs(1))
finally show "(∑i∈insert a F. discounted_value r (f i) n w) = discounted_value r (λm x. ∑i∈insert a F. f i m x) n w" .
qed
qed
lemma discounted_adapted:
assumes "borel_adapt_stoch_proc F X"
shows "borel_adapt_stoch_proc F (discounted_value r X)" unfolding adapt_stoch_proc_def
proof
fix t
show "discounted_value r X t ∈ borel_measurable (F t)" unfolding discounted_value_def
proof (rule borel_measurable_times)
show "X t ∈ borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
show "discount_factor r t ∈ borel_measurable (F t)" using discount_factor_borel_measurable by auto
qed
qed
lemma discounted_measurable:
assumes "X∈ borel_measurable N"
shows "discounted_value r (λm. X) m ∈ borel_measurable N" unfolding discounted_value_def
proof (rule borel_measurable_times)
show "X∈ borel_measurable N" using assms by simp
show "discount_factor r m ∈ borel_measurable N" using discount_factor_borel_measurable by auto
qed
lemma (in prob_space) discounted_integrable:
assumes "integrable N (X n)"
and "-1 < r"
and "space N = space M"
shows "integrable N (discounted_value r X n)" unfolding discounted_value_def
proof -
have "∃c> 0. ∀w ∈ space M. (discount_factor r n) w = c" using discount_factor_constant_time_pos assms by simp
from this obtain c where "c > 0" and "∀w ∈ space M. (discount_factor r n) w = c" by auto note cprops = this
hence "∀w ∈ space M. discount_factor r n w = c" using cprops by simp
hence "∀w ∈ space N. discount_factor r n w = c" using assms by simp
thus "integrable N (λw. discount_factor r n w * X n w)"
using ‹∀w ∈ space N. discount_factor r n w = c› assms
integrable_cong[of N N "(λw. discount_factor r n w * X n w)" "(λw. c * X n w)"] by simp
qed
subsubsection ‹Results on risk-neutral probability spaces›
definition (in rfr_disc_equity_market) risk_neutral_prob where
"risk_neutral_prob N ⟷ (prob_space N) ∧ (∀ asset ∈ stocks Mkt. martingale N F (discounted_value r (prices Mkt asset)))"
lemma integrable_val_process:
assumes "∀ asset ∈ support_set pf. integrable M (λw. prices Mkt asset n w * pf asset (Suc n) w)"
shows "integrable M (val_process Mkt pf n)"
proof (cases "portfolio pf")
case False
thus ?thesis unfolding val_process_def by simp
next
case True
hence "val_process Mkt pf n = (λw. ∑x∈support_set pf. prices Mkt x n w * pf x (Suc n) w)"
unfolding val_process_def by simp
moreover have "integrable M (λw. ∑x∈support_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms by simp
ultimately show ?thesis by simp
qed
lemma integrable_self_fin_uvp:
assumes "∀ asset ∈ support_set pf. integrable M (λw. prices Mkt asset n w * pf asset (Suc n) w)"
and "self_financing Mkt pf"
shows "integrable M (cls_val_process Mkt pf n)"
proof -
have "val_process Mkt pf n = cls_val_process Mkt pf n" using assms by (simp add:self_financingE)
moreover have "integrable M (val_process Mkt pf n)" using assms by (simp add:integrable_val_process)
ultimately show ?thesis by simp
qed
lemma (in rfr_disc_equity_market) stocks_portfolio_risk_neutral:
assumes "risk_neutral_prob N"
and "trading_strategy pf"
and "subalgebra N M"
and "support_set pf ⊆ stocks Mkt"
and "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
shows "∀x ∈ support_set pf. AE w in N.
(real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w"
proof
have nsigfin: "∀n. sigma_finite_subalgebra N (F n)" using assms unfolding risk_neutral_prob_def martingale_def subalgebra_def
using filtration filtration_def risk_neutral_prob_def prob_space.subalgebra_sigma_finite in_stock by metis
have "disc_filtr_prob_space N F"
proof -
have "prob_space N" using assms unfolding risk_neutral_prob_def by simp
moreover have "disc_filtr N F" using assms subalgebra_filtration
by (metis (no_types, lifting) filtration disc_filtr_def filtration_def)
ultimately show ?thesis
by (simp add: disc_filtr_prob_space_axioms_def disc_filtr_prob_space_def)
qed
fix asset
assume "asset ∈ support_set pf"
hence "asset ∈ stocks Mkt" using assms by auto
have "discounted_value r (prices Mkt asset) (Suc n) ∈ borel_measurable M" using assms readable
by (meson ‹asset ∈ stocks Mkt› borel_adapt_stoch_proc_borel_measurable discounted_adapted
rfr_disc_equity_market.risk_neutral_prob_def rfr_disc_equity_market_axioms)
hence b: "discounted_value r (prices Mkt asset) (Suc n) ∈ borel_measurable N"
using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by auto
show "AEeq N (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n)))
(discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n)"
proof -
have "AE w in N. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
(real_cond_exp N (F n) (λz. pf asset (Suc n) z * discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w"
proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
show "sigma_finite_subalgebra N (F n)" using nsigfin ..
show "AE w in N. discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n) w =
pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) (Suc n) w"
by (simp add: discounted_value_def)
show "discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n) ∈ borel_measurable N"
proof -
have "(λy. prices Mkt asset (Suc n) y * pf asset (Suc n) y) ∈ borel_measurable N"
using assms ‹asset∈ support_set pf› by (simp add:borel_measurable_integrable)
thus ?thesis unfolding discounted_value_def using discount_factor_borel_measurable[of r "Suc n" N] by simp
qed
show "(λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z) ∈ borel_measurable N"
proof -
have "pf asset (Suc n) ∈ borel_measurable M" using assms ‹asset∈ support_set pf› unfolding trading_strategy_def
using borel_predict_stoch_proc_borel_measurable[of "pf asset"] by auto
hence a: "pf asset (Suc n) ∈ borel_measurable N" using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by blast
show ?thesis using a b by simp
qed
qed
also have "AE w in N. (real_cond_exp N (F n) (λz. pf asset (Suc n) z * discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w =
pf asset (Suc n) w * (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w"
proof (rule sigma_finite_subalgebra.real_cond_exp_mult)
show "discounted_value r (prices Mkt asset) (Suc n) ∈ borel_measurable N" using b by simp
show "sigma_finite_subalgebra N (F n)" using nsigfin ..
show "pf asset (Suc n) ∈ borel_measurable (F n)" using assms ‹asset∈ support_set pf› unfolding trading_strategy_def
predict_stoch_proc_def by auto
show "integrable N (λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)"
proof -
have "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)" using assms ‹asset ∈ support_set pf› by auto
hence "integrable N (discounted_value r (λm w. prices Mkt asset m w * pf asset m w) (Suc n))" using assms
unfolding risk_neutral_prob_def using acceptable_rate by (auto simp add:discounted_integrable subalgebra_def)
thus ?thesis using discounted_mult
integrable_cong[of N N "discounted_value r (λm w. prices Mkt asset m w * pf asset m w) (Suc n)" "(λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)"]
by (simp add: discounted_value_def)
qed
qed
also have "AE w in N. pf asset (Suc n) w * (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w =
pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) n w"
proof -
have "AEeq N (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z))
(λz. discounted_value r (λm y. prices Mkt asset m y) n z)"
proof -
have "martingale N F (discounted_value r (prices Mkt asset))"
using assms ‹asset ∈ stocks Mkt› unfolding risk_neutral_prob_def by simp
moreover have "filtrated_prob_space N F" using ‹disc_filtr_prob_space N F›
using assms(2) disc_filtr_prob_space.axioms(1) filtrated_prob_space.intro filtrated_prob_space_axioms.intro filtration prob_space_axioms
by (metis assms(3) subalgebra_filtration)
ultimately show ?thesis using martingaleAE[of N F "discounted_value r (prices Mkt asset)" n "Suc n"] assms
by simp
qed
thus ?thesis by auto
qed
also have "AE w in N. pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) n w =
discounted_value r (λm y. pf asset (Suc m) y * prices Mkt asset m y) n w" by (simp add: discounted_value_def)
also have "AE w in N. discounted_value r (λm y. pf asset (Suc m) y * prices Mkt asset m y) n w =
discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n w"
by (simp add: discounted_value_def)
finally show "AE w in N.
(real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
(λx. discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n x) w" .
qed
qed
lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart:
assumes "risk_neutral_prob N"
and "filt_equiv F M N"
and "trading_strategy pf"
and "self_financing Mkt pf"
and "stock_portfolio Mkt pf"
and "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
and "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
shows "martingale N F (discounted_value r (cls_val_process Mkt pf))"
proof (rule disc_martingale_charact)
show nsigfin: "∀n. sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
show "filtration N F" using assms by (simp add:filt_equiv_filtration)
have "borel_adapt_stoch_proc F (discounted_value r (cls_val_process Mkt pf))" using assms discounted_adapted
cls_val_process_adapted[of pf] stock_portfolio_def
by (metis (mono_tags, hide_lams) support_adapt_def readable subsetCE)
thus "∀m. discounted_value r (cls_val_process Mkt pf) m ∈ borel_measurable (F m)" unfolding adapt_stoch_proc_def by simp
show "∀t. integrable N (discounted_value r (cls_val_process Mkt pf) t)"
proof
fix t
have "integrable N (cls_val_process Mkt pf t)" using assms by (simp add: integrable_self_fin_uvp)
thus "integrable N (discounted_value r (cls_val_process Mkt pf) t)" using assms discounted_integrable acceptable_rate
by (metis filt_equiv_space)
qed
show "∀n. AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
discounted_value r (cls_val_process Mkt pf) n w"
proof
fix n
show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
discounted_value r (cls_val_process Mkt pf) n w"
proof -
{
fix w
assume "w∈ space M"
have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
discount_factor r (Suc n) w * (∑x∈support_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)"
unfolding discounted_value_def cls_val_process_def using assms unfolding trading_strategy_def by simp
also have "... = (∑x∈support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)"
by (metis (no_types, lifting) mult.assoc sum.cong sum_distrib_left)
finally have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
(∑x∈support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" .
}
hence space: "∀w∈ space M. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
(∑x∈support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" by simp
hence nspace: "∀w∈ space N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
(∑x∈support_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms by (simp add:filt_equiv_space)
have sup_disc: "∀x ∈ support_set pf. AE w in N.
(real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w" using assms
by (simp add:stocks_portfolio_risk_neutral filt_equiv_imp_subalgebra stock_portfolio_def)
have "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
real_cond_exp N (F n) (λy. ∑x∈support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w"
proof (rule sigma_finite_subalgebra.real_cond_exp_cong')
show "sigma_finite_subalgebra N (F n)" using nsigfin ..
show "∀w∈space N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
(λy. ∑x∈support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w" using nspace
by (metis (no_types, lifting) discounted_value_def mult.assoc sum.cong)
show "(discounted_value r (cls_val_process Mkt pf) (Suc n)) ∈ borel_measurable N" using assms
using ‹∀t. integrable N (discounted_value r (cls_val_process Mkt pf) t)› by blast
qed
also have "AE w in N. real_cond_exp N (F n)
(λy. ∑x∈support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w =
(∑x∈ support_set pf. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w)"
proof (rule sigma_finite_subalgebra.real_cond_exp_bsum)
show "sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
fix asset
assume "asset ∈ support_set pf"
show "integrable N (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))"
proof (rule discounted_integrable)
show "integrable N (λy. prices Mkt asset (Suc n) y * pf asset (Suc n) y)" using assms ‹asset∈ support_set pf› by simp
show "space N = space M" using assms by (metis filt_equiv_space)
show "-1 < r" using acceptable_rate by simp
qed
qed
also have "AE w in N.
(∑x∈ support_set pf. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w) =
(∑x∈ support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w)"
proof (rule AE_sum)
show "finite (support_set pf)" using assms(3) portfolio_def trading_strategy_def by auto
show "∀x ∈ support_set pf. AE w in N.
(real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w" using sup_disc by simp
qed
also have "AE w in N.
(∑x∈ support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
discounted_value r (cls_val_process Mkt pf) n w"
proof
fix w
assume "w∈ space N"
have "(∑x∈ support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
discounted_value r (λm y. (∑x∈ support_set pf. prices Mkt x m y * pf x (Suc m) y)) n w" using discounted_sum
assms(3) portfolio_def trading_strategy_def by (simp add: discounted_value_def sum_distrib_left)
also have "... = discounted_value r (val_process Mkt pf) n w" unfolding val_process_def
by (simp add: portfolio_def)
also have "... = discounted_value r (cls_val_process Mkt pf) n w" using assms
by (simp add:self_financingE discounted_cong)
finally show "(∑x∈ support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
discounted_value r (cls_val_process Mkt pf) n w" .
qed
finally show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
discounted_value r (cls_val_process Mkt pf) n w" .
qed
qed
qed
lemma (in disc_filtr_prob_space) finite_integrable_vp:
assumes "∀n. ∀ asset ∈ support_set pf. finite (prices Mkt asset n `(space M))"
and "∀n. ∀ asset ∈ support_set pf. finite (pf asset n `(space M))"
and "prob_space N"
and "filt_equiv F M N"
and "trading_strategy pf"
and "∀n. ∀ asset ∈ support_set pf. prices Mkt asset n ∈ borel_measurable M"
shows "∀n. ∀asset∈support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (intro allI ballI)
fix n
fix asset
assume "asset∈support_set pf"
show "integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (rule prob_space.finite_borel_measurable_integrable)
show "prob_space N" using assms by simp
have "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
proof -
have "∀y∈ prices Mkt asset n `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
by (metis ‹asset ∈ support_set pf› assms(2) finite_imageI image_image)
hence "finite (⋃ y∈ prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
using ‹asset ∈ support_set pf› assms by blast
moreover have "(⋃ y∈ prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
(⋃ y∈ prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)" by simp
moreover have "((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M) ⊆
(⋃ y∈ prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
proof
fix x
assume "x ∈ (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
show "x ∈ (⋃y∈prices Mkt asset n ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
using ‹x ∈ (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M› by auto
qed
ultimately show ?thesis by (simp add:finite_subset)
qed
thus "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
have "(λw. prices Mkt asset n w * pf asset (Suc n) w) ∈ borel_measurable M"
proof -
have "prices Mkt asset n ∈ borel_measurable M" using assms ‹asset ∈ support_set pf› by simp
moreover have "pf asset (Suc n) ∈ borel_measurable M" using assms unfolding trading_strategy_def
using ‹asset ∈ support_set pf› borel_predict_stoch_proc_borel_measurable by blast
ultimately show ?thesis by simp
qed
thus "(λw. prices Mkt asset n w * pf asset (Suc n) w) ∈ borel_measurable N" using assms by (simp add:filt_equiv_measurable)
qed
qed
lemma (in disc_filtr_prob_space) finite_integrable_uvp:
assumes "∀n. ∀ asset ∈ support_set pf. finite (prices Mkt asset n `(space M))"
and "∀n. ∀ asset ∈ support_set pf. finite (pf asset n `(space M))"
and "prob_space N"
and "filt_equiv F M N"
and "trading_strategy pf"
and "∀n. ∀ asset ∈ support_set pf. prices Mkt asset n ∈ borel_measurable M"
shows "∀n. ∀asset∈support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (intro allI ballI)
fix n
fix asset
assume "asset∈support_set pf"
show "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (rule prob_space.finite_borel_measurable_integrable)
show "prob_space N" using assms by simp
have "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
proof -
have "∀y∈ prices Mkt asset (Suc n) `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
by (metis ‹asset ∈ support_set pf› assms(2) finite_imageI image_image)
hence "finite (⋃ y∈ prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
using ‹asset ∈ support_set pf› assms by blast
moreover have "(⋃ y∈ prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
(⋃ y∈ prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)" by simp
moreover have "((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) ⊆
(⋃ y∈ prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
proof
fix x
assume "x ∈ (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
show "x ∈ (⋃y∈prices Mkt asset (Suc n) ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
using ‹x ∈ (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M› by auto
qed
ultimately show ?thesis by (simp add:finite_subset)
qed
thus "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
have "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ∈ borel_measurable M"
proof -
have "prices Mkt asset (Suc n) ∈ borel_measurable M" using assms
using ‹asset ∈ support_set pf› borel_adapt_stoch_proc_borel_measurable by blast
moreover have "pf asset (Suc n) ∈ borel_measurable M" using assms unfolding trading_strategy_def
using ‹asset ∈ support_set pf› borel_predict_stoch_proc_borel_measurable by blast
ultimately show ?thesis by simp
qed
thus "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ∈ borel_measurable N" using assms by (simp add:filt_equiv_measurable)
qed
qed
lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart_finite:
assumes "risk_neutral_prob N"
and "filt_equiv F M N"
and "trading_strategy pf"
and "self_financing Mkt pf"
and "support_set pf ⊆ stocks Mkt"
and "∀n. ∀ asset ∈ support_set pf. finite (prices Mkt asset n `(space M))"
and "∀n. ∀ asset ∈ support_set pf. finite (pf asset n `(space M))"
and "∀ asset∈ stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
shows "martingale N F (discounted_value r (cls_val_process Mkt pf))"
proof (rule self_fin_trad_strat_mart, (simp add:assms)+)
show "∀n. ∀asset∈support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (intro allI ballI)
fix n
fix asset
assume "asset∈support_set pf"
show "integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (rule prob_space.finite_borel_measurable_integrable)
show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
have "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
proof -
have "∀y∈ prices Mkt asset n `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
by (metis ‹asset ∈ support_set pf› assms(7) finite_imageI image_image)
hence "finite (⋃ y∈ prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
using ‹asset ∈ support_set pf› assms(6) by blast
moreover have "(⋃ y∈ prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
(⋃ y∈ prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)" by simp
moreover have "((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M) ⊆
(⋃ y∈ prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
proof
fix x
assume "x ∈ (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
show "x ∈ (⋃y∈prices Mkt asset n ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
using ‹x ∈ (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M› by auto
qed
ultimately show ?thesis by (simp add:finite_subset)
qed
thus "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
have "(λw. prices Mkt asset n w * pf asset (Suc n) w) ∈ borel_measurable M"
proof -
have "prices Mkt asset n ∈ borel_measurable M" using assms readable
using ‹asset ∈ support_set pf› borel_adapt_stoch_proc_borel_measurable by blast
moreover have "pf asset (Suc n) ∈ borel_measurable M" using assms unfolding trading_strategy_def
using ‹asset ∈ support_set pf› borel_predict_stoch_proc_borel_measurable by blast
ultimately show ?thesis by simp
qed
thus "(λw. prices Mkt asset n w * pf asset (Suc n) w) ∈ borel_measurable N" using assms by (simp add:filt_equiv_measurable)
qed
qed
show "∀n. ∀asset∈support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (intro allI ballI)
fix n
fix asset
assume "asset∈support_set pf"
show "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (rule prob_space.finite_borel_measurable_integrable)
show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
have "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
proof -
have "∀y∈ prices Mkt asset (Suc n) `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
by (metis ‹asset ∈ support_set pf› assms(7) finite_imageI image_image)
hence "finite (⋃ y∈ prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
using ‹asset ∈ support_set pf› assms(6) by blast
moreover have "(⋃ y∈ prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
(⋃ y∈ prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)" by simp
moreover have "((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) ⊆
(⋃ y∈ prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
proof
fix x
assume "x ∈ (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
show "x ∈ (⋃y∈prices Mkt asset (Suc n) ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
using ‹x ∈ (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M› by auto
qed
ultimately show ?thesis by (simp add:finite_subset)
qed
thus "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
have "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ∈ borel_measurable M"
proof -
have "prices Mkt asset (Suc n) ∈ borel_measurable M" using assms readable
using ‹asset ∈ support_set pf› borel_adapt_stoch_proc_borel_measurable by blast
moreover have "pf asset (Suc n) ∈ borel_measurable M" using assms unfolding trading_strategy_def
using ‹asset ∈ support_set pf› borel_predict_stoch_proc_borel_measurable by blast
ultimately show ?thesis by simp
qed
thus "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ∈ borel_measurable N" using assms by (simp add:filt_equiv_measurable)
qed
qed
show "stock_portfolio Mkt pf" using assms stock_portfolio_def
by (simp add: stock_portfolio_def trading_strategy_def)
qed
lemma (in rfr_disc_equity_market) replicating_expectation:
assumes "risk_neutral_prob N"
and "filt_equiv F M N"
and "replicating_portfolio pf pyf matur"
and "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
and "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
and "viable_market Mkt"
and "sets (F 0) = {{}, space M}"
and "pyf ∈ borel_measurable (F matur)"
shows "fair_price Mkt (prob_space.expectation N (discounted_value r (λm. pyf) matur)) pyf matur"
proof -
have fn: "filtrated_prob_space N F" using assms
by (simp add: ‹pyf ∈ borel_measurable (F matur)› filtrated_prob_space_axioms.intro
filtrated_prob_space_def risk_neutral_prob_def filt_equiv_filtration)
have "discounted_value r (cls_val_process Mkt pf) matur ∈ borel_measurable N"
using assms(3) disc_equity_market.replicating_portfolio_def disc_equity_market_axioms discounted_adapted
filtrated_prob_space.borel_adapt_stoch_proc_borel_measurable fn cls_val_process_adapted
by (metis (no_types, hide_lams) support_adapt_def readable stock_portfolio_def subsetCE)
have "discounted_value r (λm. pyf) matur ∈ borel_measurable N"
proof -
have "(λm. pyf) matur ∈ borel_measurable (F matur)" using assms by simp
hence "(λm. pyf) matur ∈ borel_measurable M" using filtration filtrationE1 measurable_from_subalg by blast
hence "(λm. pyf) matur ∈ borel_measurable N" using assms by (simp add:filt_equiv_measurable)
thus ?thesis by (simp add:discounted_measurable)
qed
have mpyf: "AE w in M. cls_val_process Mkt pf matur w = pyf w" using assms unfolding replicating_portfolio_def by simp
have "AE w in N. cls_val_process Mkt pf matur w = pyf w"
proof (rule filt_equiv_borel_AE_eq)
show "filt_equiv F M N" using assms by simp
show "pyf ∈ borel_measurable (F matur)" using assms by simp
show "AE w in M. cls_val_process Mkt pf matur w = pyf w" using mpyf by simp
show "cls_val_process Mkt pf matur ∈ borel_measurable (F matur)"
using assms(3) price_structure_def replicating_price_process
by (meson support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms readable stock_portfolio_def subsetCE)
qed
hence disc:"AE w in N. discounted_value r (cls_val_process Mkt pf) matur w = discounted_value r (λm. pyf) matur w"
by (simp add:discounted_AE_cong)
have "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
(real_cond_exp N (F 0) (discounted_value r (λm. pyf) matur))"
proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
show "sigma_finite_subalgebra N (F 0)"
using filtrated_prob_space.axioms(1) filtrated_prob_space.filtration fn filtrationE1
prob_space.subalgebra_sigma_finite by blast
show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (λm. pyf) matur)" using disc by simp
show "discounted_value r (cls_val_process Mkt pf) matur ∈ borel_measurable N"
using ‹discounted_value r (cls_val_process Mkt pf) matur ∈ borel_measurable N› .
show "discounted_value r (λm. pyf) matur ∈ borel_measurable N"
using ‹discounted_value r (λm. pyf) matur ∈ borel_measurable N› .
qed
have "martingale N F (discounted_value r (cls_val_process Mkt pf))" using assms unfolding replicating_portfolio_def
using self_fin_trad_strat_mart[of N pf] by (simp add: stock_portfolio_def)
hence "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
(discounted_value r (cls_val_process Mkt pf) 0)" using martingaleAE[of N F "discounted_value r (cls_val_process Mkt pf)" 0 matur]
fn by simp
also have "AE w in N. (discounted_value r (cls_val_process Mkt pf) 0 w) = initial_value pf"
proof
fix w
assume "w∈ space N"
have "discounted_value r (cls_val_process Mkt pf) 0 w = cls_val_process Mkt pf 0 w" by (simp add:discounted_init)
also have "... = val_process Mkt pf 0 w" unfolding cls_val_process_def using assms
unfolding replicating_portfolio_def stock_portfolio_def by simp
also have "... = initial_value pf" using assms unfolding replicating_portfolio_def using ‹w∈ space N›
by (metis (no_types, lifting) support_adapt_def filt_equiv_space initial_valueI readable stock_portfolio_def subsetCE)
finally show "discounted_value r (cls_val_process Mkt pf) 0 w = initial_value pf" .
qed
finally have "AE w in N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
initial_value pf" .
moreover have "∀w∈ space N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur)"
proof (rule prob_space.trivial_subalg_cond_expect_eq)
show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
show "subalgebra N (F 0)"
using ‹prob_space N› filtrated_prob_space.filtration fn filtrationE1 by blast
show "sets (F 0) = {{}, space N}" using assms by (simp add:filt_equiv_space)
show "integrable N (discounted_value r (cls_val_process Mkt pf) matur)"
proof (rule discounted_integrable)
show "space N = space M" using assms by (simp add:filt_equiv_space)
show "integrable N (cls_val_process Mkt pf matur)" using assms unfolding replicating_portfolio_def
by (simp add: integrable_self_fin_uvp)
show "-1 < r" using acceptable_rate by simp
qed
qed
ultimately have "AE w in N. prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
initial_value pf" by simp
hence "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
initial_value pf" using assms unfolding risk_neutral_prob_def using prob_space.emeasure_space_1[of N]
AE_eq_cst[of _ _ N] by simp
moreover have "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
prob_space.expectation N (discounted_value r (λm. pyf) matur)"
proof (rule integral_cong_AE)
show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (λm. pyf) matur)"
using disc by simp
show "discounted_value r (λm. pyf) matur ∈ borel_measurable N"
using ‹discounted_value r (λm. pyf) matur ∈ borel_measurable N› .
show "discounted_value r (cls_val_process Mkt pf) matur ∈ borel_measurable N"
using ‹discounted_value r (cls_val_process Mkt pf) matur ∈ borel_measurable N› .
qed
ultimately have "prob_space.expectation N (discounted_value r (λm. pyf) matur) = initial_value pf" by simp
thus ?thesis using assms
by (metis (full_types) support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms
readable replicating_fair_price stock_portfolio_def subsetCE)
qed
lemma (in rfr_disc_equity_market) replicating_expectation_finite:
assumes "risk_neutral_prob N"
and "filt_equiv F M N"
and "replicating_portfolio pf pyf matur"
and "∀n. ∀ asset ∈ support_set pf. finite (prices Mkt asset n `(space M))"
and "∀n. ∀ asset ∈ support_set pf. finite (pf asset n `(space M))"
and "viable_market Mkt"
and "sets (F 0) = {{}, space M}"
and "pyf ∈ borel_measurable (F matur)"
shows "fair_price Mkt (prob_space.expectation N (discounted_value r (λm. pyf) matur)) pyf matur"
proof -
have "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (rule finite_integrable_vp, (auto simp add:assms))
show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
show "⋀n asset. asset ∈ support_set pf ⟹ random_variable borel (prices Mkt asset n)"
proof-
fix n
fix asset
assume "asset ∈ support_set pf"
show "random_variable borel (prices Mkt asset n)"
using assms unfolding replicating_portfolio_def stock_portfolio_def adapt_stoch_proc_def using readable
by (meson ‹asset ∈ support_set pf› adapt_stoch_proc_borel_measurable subsetCE)
qed
qed
moreover have "∀n. ∀ asset ∈ support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (rule finite_integrable_uvp, (auto simp add:assms))
show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
show "⋀n asset. asset ∈ support_set pf ⟹ random_variable borel (prices Mkt asset n)"
proof-
fix n
fix asset
assume "asset ∈ support_set pf"
show "random_variable borel (prices Mkt asset n)"
using assms unfolding replicating_portfolio_def stock_portfolio_def adapt_stoch_proc_def using readable
by (meson ‹asset ∈ support_set pf› adapt_stoch_proc_borel_measurable subsetCE)
qed
qed
ultimately show ?thesis using assms replicating_expectation by simp
qed
end
Theory CRR_Model
section ‹The Cox Ross Rubinstein model›
text ‹This section defines the Cox-Ross-Rubinstein model of a financial market, and charcterizes a risk-neutral
probability space for this market. This, together with the proof that every derivative is attainable, permits to
obtain a formula to explicitely compute the fair price of any derivative.›
theory CRR_Model imports Fair_Price
begin
locale CRR_hyps = prob_grw + rsk_free_asset +
fixes stk
assumes stocks: "stocks Mkt = {stk, risk_free_asset}"
and stk_price: "prices Mkt stk = geom_proc"
and S0_positive: "0 < init"
and down_positive: "0 < d" and down_lt_up: "d < u"
and psgt: "0 < p"
and pslt: "p < 1"
locale CRR_market = CRR_hyps +
fixes G
assumes stock_filtration:"G = stoch_proc_filt M geom_proc borel"
subsection ‹Preliminary results on the market›
lemma (in CRR_market) case_asset:
assumes "asset ∈ stocks Mkt"
shows "asset = stk ∨ asset = risk_free_asset"
proof (rule ccontr)
assume "¬ (asset = stk ∨ asset = risk_free_asset)"
hence "asset ≠ stk ∧ asset ≠ risk_free_asset" by simp
moreover have "asset ∈ {stk, risk_free_asset}" using assms stocks by simp
ultimately show False by auto
qed
lemma (in CRR_market)
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows bernoulli_gen_filtration: "filtration N G"
and bernoulli_sigma_finite: "∀n. sigma_finite_subalgebra N (G n)"
proof -
show "filtration N G"
proof -
have "disc_filtr M (stoch_proc_filt M geom_proc borel)"
proof (rule stoch_proc_filt_disc_filtr)
fix i
show "random_variable borel (geom_proc i)"
by (simp add: geom_rand_walk_borel_measurable)
qed
hence "filtration M G" using stock_filtration by (simp add: filtration_def disc_filtr_def)
have "filt_equiv nat_filtration M N" using pslt psgt by (simp add: assms bernoulli_stream_equiv)
hence "sets N = sets M" unfolding filt_equiv_def by simp
thus ?thesis unfolding filtration_def
by (metis filtration_def ‹Filtration.filtration M G› sets_eq_imp_space_eq subalgebra_def)
qed
show "∀n. sigma_finite_subalgebra N (G n)" using assms unfolding subalgebra_def
using filtration_def subalgebra_sigma_finite
by (metis ‹Filtration.filtration N G› bernoulli_stream_def prob_space.prob_space_stream_space
prob_space.subalgebra_sigma_finite prob_space_measure_pmf)
qed
sublocale CRR_market ⊆ rfr_disc_equity_market _ G
proof (unfold_locales)
show "disc_filtr M G ∧ sets (G ⊥) = {{}, space M}"
proof
show "sets (G ⊥) = {{}, space M}" using infinite_cts_filtration.stoch_proc_filt_triv_init stock_filtration geometric_process
geom_rand_walk_borel_adapted
by (meson infinite_coin_toss_space_axioms infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
init_triv_filt_def)
show "disc_filtr M G"
by (metis Filtration.filtration_def bernoulli bernoulli_gen_filtration disc_filtr_def psgt pslt)
qed
show "∀asset∈stocks Mkt. borel_adapt_stoch_proc G (prices Mkt asset)"
proof -
have "borel_adapt_stoch_proc G (prices Mkt stk)" using stk_price stock_filtration stoch_proc_filt_adapt
by (simp add: stoch_proc_filt_adapt geom_rand_walk_borel_measurable)
moreover have "borel_adapt_stoch_proc G (prices Mkt risk_free_asset)"
using ‹disc_filtr M G ∧ sets (G ⊥) = {{}, space M}› disc_filtr_prob_space.disc_rfr_proc_borel_adapted
disc_filtr_prob_space.intro disc_filtr_prob_space_axioms.intro prob_space_axioms rf_price by fastforce
moreover have "disc_filtr_prob_space M G" proof (unfold_locales)
show "disc_filtr M G" by (simp add: ‹disc_filtr M G ∧ sets (G ⊥) = {{}, space M}›)
qed
ultimately show ?thesis using stocks by force
qed
qed
lemma (in CRR_market) two_stocks:
shows "stk ≠ risk_free_asset"
proof (rule ccontr)
assume "¬stk ≠ risk_free_asset"
hence "disc_rfr_proc r = prices Mkt stk" using rf_price by simp
also have "... = geom_proc" using stk_price by simp
finally have eqf: "disc_rfr_proc r = geom_proc" .
hence "∀w. disc_rfr_proc r 0 w = geom_proc 0 w" by simp
hence "1 = init" using geometric_process by simp
have eqfs: "∀w. disc_rfr_proc r (Suc 0) w = geom_proc (Suc 0) w" using eqf by simp
hence "disc_rfr_proc r (Suc 0) (sconst True) = geom_proc (Suc 0) (sconst True)" by simp
hence "1+r = u" using geometric_process ‹1 = init› by simp
have "disc_rfr_proc r (Suc 0) (sconst False) = geom_proc (Suc 0) (sconst False)" using eqfs by simp
hence "1+r = d" using geometric_process ‹1 = init› by simp
show False using ‹1+r = u› ‹1+r = d› down_lt_up by simp
qed
lemma (in CRR_market) stock_pf_vp_expand:
assumes "stock_portfolio Mkt pf"
shows "val_process Mkt pf n w = geom_proc n w * pf stk (Suc n) w +
disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
proof -
have "val_process Mkt pf n w =(sum (λx. ((prices Mkt) x n w) * (pf x (Suc n) w)) (stocks Mkt))"
proof (rule subset_val_process')
show "finite (stocks Mkt)" using stocks by auto
show "support_set pf ⊆ stocks Mkt" using assms unfolding stock_portfolio_def by simp
qed
also have "... = (∑x∈ {stk, risk_free_asset}. ((prices Mkt) x n w) * (pf x (Suc n) w))" using stocks by simp
also have "... = prices Mkt stk n w * pf stk (Suc n) w +
(∑ x∈ {risk_free_asset}. ((prices Mkt) x n w) * (pf x (Suc n) w))" by (simp add:two_stocks)
also have "... = prices Mkt stk n w * pf stk (Suc n) w +
prices Mkt risk_free_asset n w * pf risk_free_asset (Suc n) w" by simp
also have "... = geom_proc n w * pf stk (Suc n) w + disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
using rf_price stk_price by simp
finally show ?thesis .
qed
lemma (in CRR_market) stock_pf_uvp_expand:
assumes "stock_portfolio Mkt pf"
shows "cls_val_process Mkt pf (Suc n) w = geom_proc (Suc n) w * pf stk (Suc n) w +
disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
proof -
have "cls_val_process Mkt pf (Suc n) w =(sum (λx. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w)) (stocks Mkt))"
proof (rule subset_cls_val_process')
show "finite (stocks Mkt)" using stocks by auto
show "support_set pf ⊆ stocks Mkt" using assms unfolding stock_portfolio_def by simp
qed
also have "... = (∑x∈ {stk, risk_free_asset}. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w))" using stocks by simp
also have "... = prices Mkt stk (Suc n) w * pf stk (Suc n) w +
(∑ x∈ {risk_free_asset}. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w))" by (simp add:two_stocks)
also have "... = prices Mkt stk (Suc n) w * pf stk (Suc n) w +
prices Mkt risk_free_asset (Suc n) w * pf risk_free_asset (Suc n) w" by simp
also have "... = geom_proc (Suc n) w * pf stk (Suc n) w + disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
using rf_price stk_price by simp
finally show ?thesis .
qed
lemma (in CRR_market) pos_pf_neg_uvp:
assumes "stock_portfolio Mkt pf"
and "d < 1+r"
and "0 < pf stk (Suc n) (spick w n False)"
and "val_process Mkt pf n (spick w n False) ≤ 0"
shows "cls_val_process Mkt pf (Suc n) (spick w n False) < 0"
proof -
define wnf where "wnf = spick w n False"
have "cls_val_process Mkt pf (Suc n) (spick w n False) =
geom_proc (Suc n) wnf * pf stk (Suc n) wnf +
disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf" unfolding wnf_def
using assms by (simp add:stock_pf_uvp_expand)
also have "... = d * geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf"
unfolding wnf_def using geometric_process spickI[of n w False] by simp
also have "... = d * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
by simp
also have "... < (1+r) * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
unfolding wnf_def using assms geom_rand_walk_strictly_positive S0_positive
down_positive down_lt_up by simp
also have "... = (1+r) * (geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf)"
by (simp add: distrib_left)
also have "... = (1+r) * val_process Mkt pf n wnf" using stock_pf_vp_expand assms by simp
also have "... ≤ 0"
proof -
have "0 < 1+r" using assms down_positive by simp
moreover have "val_process Mkt pf n wnf ≤ 0" using assms unfolding wnf_def by simp
ultimately show "(1+r) * (val_process Mkt pf n wnf) ≤ 0" unfolding wnf_def
using less_eq_real_def[of 0 "1+r"] mult_nonneg_nonpos[of "1+r" "val_process Mkt pf n (spick w n False)"] by simp
qed
finally show ?thesis .
qed
lemma (in CRR_market) neg_pf_neg_uvp:
assumes "stock_portfolio Mkt pf"
and "1+r < u"
and "pf stk (Suc n) (spick w n True) < 0"
and "val_process Mkt pf n (spick w n True) ≤ 0"
shows "cls_val_process Mkt pf (Suc n) (spick w n True) < 0"
proof -
define wnf where "wnf = spick w n True"
have "cls_val_process Mkt pf (Suc n) (spick w n True) =
geom_proc (Suc n) wnf * pf stk (Suc n) wnf +
disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf" unfolding wnf_def
using assms by (simp add:stock_pf_uvp_expand)
also have "... = u * geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf"
unfolding wnf_def using geometric_process spickI[of n w True] by simp
also have "... = u * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
by simp
also have "... < (1+r) * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
unfolding wnf_def using assms geom_rand_walk_strictly_positive S0_positive
down_positive down_lt_up by simp
also have "... = (1+r) * (geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf)"
by (simp add: distrib_left)
also have "... = (1+r) * val_process Mkt pf n wnf" using stock_pf_vp_expand assms by simp
also have "... ≤ 0"
proof -
have "0 < 1+r" using acceptable_rate by simp
moreover have "val_process Mkt pf n wnf ≤ 0" using assms unfolding wnf_def by simp
ultimately show "(1+r) * (val_process Mkt pf n wnf) ≤ 0" unfolding wnf_def
using less_eq_real_def[of 0 "1+r"] mult_nonneg_nonpos[of "1+r" "val_process Mkt pf n (spick w n True)"] by simp
qed
finally show ?thesis .
qed
lemma (in CRR_market) zero_pf_neg_uvp:
assumes "stock_portfolio Mkt pf"
and "pf stk (Suc n) w = 0"
and "pf risk_free_asset (Suc n) w ≠ 0"
and "val_process Mkt pf n w ≤ 0"
shows "cls_val_process Mkt pf (Suc n) w < 0"
proof -
have "cls_val_process Mkt pf (Suc n) w =
S (Suc n) w * pf stk (Suc n) w +
disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
using assms by (simp add:stock_pf_uvp_expand)
also have "... = disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w" using assms by simp
also have "... = (1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" by simp
also have "... < 0"
proof -
have "0 < 1+r" using acceptable_rate by simp
moreover have "0 < disc_rfr_proc r n w" using acceptable_rate by (simp add: disc_rfr_proc_positive)
ultimately have "0 < (1+r) * disc_rfr_proc r n w" by simp
have 1: "0< pf risk_free_asset (Suc n) w ⟶ 0 <(1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
proof (intro impI)
assume "0 < pf risk_free_asset (Suc n) w"
thus "0 < (1 + r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using ‹0 < (1+r) * disc_rfr_proc r n w›
by simp
qed
have 2: "pf risk_free_asset (Suc n) w < 0 ⟶ (1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w < 0"
proof (intro impI)
assume "pf risk_free_asset (Suc n) w < 0"
thus "(1 + r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w < 0" using ‹0 < (1+r) * disc_rfr_proc r n w›
by (simp add:mult_pos_neg)
qed
have "0 ≥ val_process Mkt pf n w" using assms by simp
also have "val_process Mkt pf n w = geom_proc n w * pf stk (Suc n) w +
disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using assms by (simp add:stock_pf_vp_expand)
also have "... = disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using assms by simp
finally have "0≥ disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" .
have "0< pf risk_free_asset (Suc n) w ∨ pf risk_free_asset (Suc n) w < 0" using assms
by linarith
thus ?thesis
using "2" ‹0 < disc_rfr_proc r n w› ‹disc_rfr_proc r n w * pf risk_free_asset (Suc n) w ≤ 0›
mult_pos_pos by fastforce
qed
finally show ?thesis .
qed
lemma (in CRR_market) neg_pf_exists:
assumes "stock_portfolio Mkt pf"
and "trading_strategy pf"
and "1+r < u"
and "d < 1+r"
and "val_process Mkt pf n w ≤ 0"
and "pf stk (Suc n) w ≠ 0 ∨ pf risk_free_asset (Suc n) w ≠ 0"
shows "∃y. cls_val_process Mkt pf (Suc n) y < 0"
proof -
have "borel_predict_stoch_proc G (pf stk)"
proof (rule inc_predict_support_trading_strat')
show "trading_strategy pf" using assms by simp
show "stk ∈ support_set pf ∪ {stk}" by simp
qed
hence "pf stk (Suc n) ∈ borel_measurable (G n)" unfolding predict_stoch_proc_def by simp
have "val_process Mkt pf n ∈ borel_measurable (G n)"
proof -
have "borel_adapt_stoch_proc G (val_process Mkt pf)" using assms
using support_adapt_def ats_val_process_adapted readable unfolding stock_portfolio_def by blast
thus ?thesis unfolding adapt_stoch_proc_def by simp
qed
define wn where "wn = pseudo_proj_True n w"
show ?thesis
proof (cases "pf stk (Suc n) w ≠ 0")
case True
show ?thesis
proof (cases "pf stk (Suc n) w > 0")
case True
have "0 <pf stk (Suc n) (spick wn n False)"
proof -
have "0 < pf stk (Suc n) w" using ‹0 < pf stk (Suc n) w› by simp
also have "... = pf stk (Suc n) wn" unfolding wn_def
using ‹pf stk (Suc n) ∈ borel_measurable (G n)› stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
nat_filtration_info stock_filtration
by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
also have "... = pf stk (Suc n) (spick wn n False)" using ‹pf stk (Suc n) ∈ borel_measurable (G n)› comp_def nat_filtration_info
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
finally show ?thesis .
qed
moreover have "0 ≥ val_process Mkt pf n (spick wn n False)"
proof -
have "0 ≥ val_process Mkt pf n w" using assms by simp
also have "val_process Mkt pf n w = val_process Mkt pf n wn" unfolding wn_def using ‹val_process Mkt pf n ∈ borel_measurable (G n)›
nat_filtration_info stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
stock_filtration by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
also have "... = val_process Mkt pf n (spick wn n False)" using ‹val_process Mkt pf n ∈ borel_measurable (G n)›
comp_def nat_filtration_info
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
finally show ?thesis .
qed
ultimately have "cls_val_process Mkt pf (Suc n) (spick wn n False) < 0" using assms
by (simp add:pos_pf_neg_uvp)
thus "∃y. cls_val_process Mkt pf (Suc n) y < 0" by auto
next
case False
have "0 >pf stk (Suc n) (spick wn n True)"
proof -
have "0 > pf stk (Suc n) w" using ‹¬ 0 < pf stk (Suc n) w› ‹pf stk (Suc n) w ≠ 0› by simp
also have "pf stk (Suc n) w = pf stk (Suc n) wn" unfolding wn_def using ‹pf stk (Suc n) ∈ borel_measurable (G n)›
nat_filtration_info stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
stock_filtration by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
also have "... = pf stk (Suc n) (spick wn n True)" using ‹pf stk (Suc n) ∈ borel_measurable (G n)›
comp_def nat_filtration_info
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
finally show ?thesis .
qed
moreover have "0 ≥ val_process Mkt pf n (spick wn n True)"
proof -
have "0 ≥ val_process Mkt pf n w" using assms by simp
also have "val_process Mkt pf n w = val_process Mkt pf n wn" unfolding wn_def using ‹val_process Mkt pf n ∈ borel_measurable (G n)›
comp_def nat_filtration_info
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
also have "... = val_process Mkt pf n (spick wn n True)" using ‹val_process Mkt pf n ∈ borel_measurable (G n)›
comp_def nat_filtration_info
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
finally show ?thesis .
qed
ultimately have "cls_val_process Mkt pf (Suc n) (spick wn n True) < 0" using assms
by (simp add:neg_pf_neg_uvp)
thus "∃y. cls_val_process Mkt pf (Suc n) y < 0" by auto
qed
next
case False
hence "pf risk_free_asset (Suc n) w ≠ 0" using assms by simp
hence "cls_val_process Mkt pf (Suc n) w < 0" using False assms by (auto simp add:zero_pf_neg_uvp)
thus "∃y. cls_val_process Mkt pf (Suc n) y < 0" by auto
qed
qed
lemma (in CRR_market) non_zero_components:
assumes "val_process Mkt pf n y ≠ 0"
and "stock_portfolio Mkt pf"
shows "pf stk (Suc n) y ≠ 0 ∨ pf risk_free_asset (Suc n) y ≠ 0"
proof (rule ccontr)
assume "¬(pf stk (Suc n) y ≠ 0 ∨ pf risk_free_asset (Suc n) y ≠ 0)"
hence "pf stk (Suc n) y = 0" "pf risk_free_asset (Suc n) y = 0" by auto
have "val_process Mkt pf n y = geom_proc n y * pf stk (Suc n) y +
disc_rfr_proc r n y * pf risk_free_asset (Suc n) y" using ‹stock_portfolio Mkt pf›
stock_pf_vp_expand[of pf n] by simp
also have "... = 0" using ‹pf stk (Suc n) y = 0› ‹pf risk_free_asset (Suc n) y = 0› by simp
finally have "val_process Mkt pf n y = 0" .
moreover have "val_process Mkt pf n y ≠ 0" using assms by simp
ultimately show False by simp
qed
lemma (in CRR_market) neg_pf_Suc:
assumes "stock_portfolio Mkt pf"
and "trading_strategy pf"
and "self_financing Mkt pf"
and "1+r < u"
and "d < 1+r"
and "cls_val_process Mkt pf n w < 0"
shows "n ≤ m ⟹ ∃y. cls_val_process Mkt pf m y < 0"
proof (induct m)
case 0
assume "n ≤ 0"
hence "n=0" by simp
thus "∃y. cls_val_process Mkt pf 0 y < 0" using assms by auto
next
case (Suc m)
assume "n ≤ Suc m"
thus "∃y. cls_val_process Mkt pf (Suc m) y < 0"
proof (cases "n < Suc m")
case False
hence "n = Suc m" using ‹n ≤ Suc m› by simp
thus "∃y. cls_val_process Mkt pf (Suc m) y < 0" using assms by auto
next
case True
hence "n ≤ m" by simp
hence "∃y. cls_val_process Mkt pf m y < 0" using Suc by simp
from this obtain y where "cls_val_process Mkt pf m y < 0" by auto
hence "val_process Mkt pf m y < 0" using assms by (simp add:self_financingE)
hence "val_process Mkt pf m y ≤ 0" by simp
have "val_process Mkt pf m y ≠ 0" using ‹val_process Mkt pf m y < 0› by simp
hence "pf stk (Suc m) y ≠ 0 ∨ pf risk_free_asset (Suc m) y ≠ 0" using assms non_zero_components by simp
thus "∃y. cls_val_process Mkt pf (Suc m) y < 0" using neg_pf_exists[of pf m y] assms
‹val_process Mkt pf m y ≤ 0› by simp
qed
qed
lemma (in CRR_market) viable_if:
assumes "1+r < u"
and "d < 1+r"
shows "viable_market Mkt" unfolding viable_market_def
proof (rule ccontr)
assume "¬(∀p. stock_portfolio Mkt p ⟶ ¬ arbitrage_process Mkt p)"
hence "∃p. stock_portfolio Mkt p ∧ arbitrage_process Mkt p" by simp
from this obtain pf where "stock_portfolio Mkt pf" and "arbitrage_process Mkt pf" by auto
have "(∃ m. (self_financing Mkt pf) ∧ (trading_strategy pf) ∧
(∀w ∈ space M. cls_val_process Mkt pf 0 w = 0) ∧
(AE w in M. 0 ≤ cls_val_process Mkt pf m w) ∧
0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0))" using ‹arbitrage_process Mkt pf›
using arbitrage_processE by simp
from this obtain m where "self_financing Mkt pf" and "(trading_strategy pf)"
and "(∀w ∈ space M. cls_val_process Mkt pf 0 w = 0)"
and "(AE w in M. 0 ≤ cls_val_process Mkt pf m w)"
and "0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0)" by auto
have "{w∈ space M. cls_val_process Mkt pf m w > 0} ≠ {}" using
‹0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0)› by force
hence "∃w∈ space M. cls_val_process Mkt pf m w > 0" by auto
from this obtain y where "y∈ space M" and "cls_val_process Mkt pf m y > 0" by auto
define A where "A = {n::nat. n ≤ m ∧ cls_val_process Mkt pf n y > 0}"
have "finite A" unfolding A_def by auto
have "m ∈ A" using ‹cls_val_process Mkt pf m y > 0› unfolding A_def by simp
hence "A ≠ {}" by auto
hence "Min A ∈ A" using ‹finite A› by simp
have "Min A ≤ m" using ‹finite A› ‹m∈ A› by simp
have "0 < Min A"
proof -
have "cls_val_process Mkt pf 0 y = 0" using ‹y∈ space M› ‹∀w ∈ space M. cls_val_process Mkt pf 0 w = 0›
by simp
hence "0∉ A" unfolding A_def by simp
moreover have "0 ≤ Min A" by simp
ultimately show ?thesis using ‹Min A ∈ A› neq0_conv by fastforce
qed
hence "∃l. Suc l = Min A" using Suc_diff_1 by blast
from this obtain l where "Suc l = Min A" by auto
have "cls_val_process Mkt pf l y ≤ 0"
proof -
have "l < Min A" using ‹Suc l = Min A› by simp
hence "l∉ A" using ‹finite A› ‹A ≠ {}› by auto
moreover have "l ≤ m" using ‹Suc l = Min A› ‹m∈ A› ‹finite A› ‹A ≠ {}› ‹l < Min A› by auto
ultimately show ?thesis unfolding A_def by auto
qed
hence "val_process Mkt pf l y ≤ 0" using ‹self_financing Mkt pf› by (simp add:self_financingE)
moreover have "pf stk (Suc l) y ≠ 0 ∨ pf risk_free_asset (Suc l) y ≠ 0"
proof (rule ccontr)
assume "¬(pf stk (Suc l) y ≠ 0 ∨ pf risk_free_asset (Suc l) y ≠ 0)"
hence "pf stk (Suc l) y = 0" "pf risk_free_asset (Suc l) y = 0" by auto
have "cls_val_process Mkt pf (Min A) y = geom_proc (Suc l) y * pf stk (Suc l) y +
disc_rfr_proc r (Suc l) y * pf risk_free_asset (Suc l) y" using ‹stock_portfolio Mkt pf›
‹Suc l = Min A› stock_pf_uvp_expand[of pf l] by simp
also have "... = 0" using ‹pf stk (Suc l) y = 0› ‹pf risk_free_asset (Suc l) y = 0› by simp
finally have "cls_val_process Mkt pf (Min A) y = 0" .
moreover have "cls_val_process Mkt pf (Min A) y > 0" using ‹Min A ∈ A› unfolding A_def by simp
ultimately show False by simp
qed
ultimately have "∃z. cls_val_process Mkt pf (Suc l) z < 0" using assms ‹stock_portfolio Mkt pf›
‹trading_strategy pf› by (simp add:neg_pf_exists)
from this obtain z where "cls_val_process Mkt pf (Suc l) z < 0" by auto
hence "∃x'. cls_val_process Mkt pf m x' < 0" using neg_pf_Suc assms ‹trading_strategy pf›
‹self_financing Mkt pf› ‹Suc l = Min A› ‹Min A ≤ m› ‹stock_portfolio Mkt pf› by simp
from this obtain x' where "cls_val_process Mkt pf m x' < 0" by auto
have "x'∈ space M" using bernoulli_stream_space bernoulli by auto
hence "x'∈ {w∈ space M. ¬0 ≤ cls_val_process Mkt pf m w}" using ‹cls_val_process Mkt pf m x' < 0› by auto
from ‹AE w in M. 0 ≤ cls_val_process Mkt pf m w› obtain N where
"{w∈ space M. ¬0 ≤ cls_val_process Mkt pf m w} ⊆ N" and "emeasure M N = 0" and "N∈ sets M" using AE_E by auto
have "{w∈ space M. (stake m w = stake m x')} ⊆ N"
proof
fix x
assume "x ∈ {w ∈ space M. stake m w = stake m x'}"
hence "x∈ space M" and "stake m x = stake m x'" by auto
have "cls_val_process Mkt pf m ∈ borel_measurable (G m)"
proof -
have "borel_adapt_stoch_proc G (cls_val_process Mkt pf)" using ‹trading_strategy pf› ‹stock_portfolio Mkt pf›
by (meson support_adapt_def readable stock_portfolio_def subsetCE cls_val_process_adapted)
thus ?thesis unfolding adapt_stoch_proc_def by simp
qed
hence "cls_val_process Mkt pf m x' = cls_val_process Mkt pf m x"
using ‹stake m x = stake m x'› borel_measurable_stake[of "cls_val_process Mkt pf m" m x x']
pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
hence "cls_val_process Mkt pf m x < 0" using ‹cls_val_process Mkt pf m x' < 0› by simp
thus "x∈ N" using ‹{w∈ space M. ¬0 ≤ cls_val_process Mkt pf m w} ⊆ N› ‹x∈ space M›
‹cls_val_process Mkt pf (Suc l) z < 0› by auto
qed
moreover have "emeasure M {w∈ space M. (stake m w = stake m x')} ≠ 0" using bernoulli_stream_pref_prob_neq_zero psgt pslt by simp
ultimately show False using ‹emeasure M N = 0› ‹N ∈ events› emeasure_eq_0 by blast
qed
lemma (in CRR_market) viable_only_if_d:
assumes "viable_market Mkt"
shows "d < 1+r"
proof (rule ccontr)
assume "¬ d < 1+r"
hence "1+r ≤ d" by simp
define arb_pf where "arb_pf = (λ (x::'a) (n::nat) w. 0::real)(stk:= (λ n w. 1), risk_free_asset := (λ n w. - geom_proc 0 w))"
have "support_set arb_pf = {stk, risk_free_asset}"
proof
show "support_set arb_pf ⊆ {stk, risk_free_asset}"
by (simp add: arb_pf_def subset_iff support_set_def)
have "stk∈ support_set arb_pf" unfolding arb_pf_def support_set_def using two_stocks by simp
moreover have "risk_free_asset∈ support_set arb_pf" unfolding arb_pf_def support_set_def
using two_stocks geometric_process S0_positive by simp
ultimately show "{stk, risk_free_asset}⊆ support_set arb_pf" by simp
qed
hence "stock_portfolio Mkt arb_pf" using stocks
by (simp add: portfolio_def stock_portfolio_def)
have "arbitrage_process Mkt arb_pf"
proof (rule arbitrage_processI, intro exI conjI)
show "self_financing Mkt arb_pf" unfolding arb_pf_def using ‹support_set arb_pf = {stk, risk_free_asset}›
by (simp add: static_portfolio_self_financing)
show "trading_strategy arb_pf" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio arb_pf" unfolding portfolio_def using ‹support_set arb_pf = {stk, risk_free_asset}› by simp
fix asset
assume "asset∈ support_set arb_pf"
show "borel_predict_stoch_proc G (arb_pf asset)"
proof (cases "asset = stk")
case True
hence "arb_pf asset = (λ n w. 1)" unfolding arb_pf_def by (simp add: two_stocks)
show ?thesis unfolding predict_stoch_proc_def
proof
show "arb_pf asset 0 ∈ borel_measurable (G 0)" using ‹arb_pf asset = (λ n w. 1)› by simp
show "∀n. arb_pf asset (Suc n) ∈ borel_measurable (G n)"
proof
fix n
show "arb_pf asset (Suc n) ∈ borel_measurable (G n)" using ‹arb_pf asset = (λ n w. 1)› by simp
qed
qed
next
case False
hence "arb_pf asset = (λ n w. - geom_proc 0 w)" using ‹support_set arb_pf = {stk, risk_free_asset}›
‹asset ∈ support_set arb_pf› unfolding arb_pf_def by simp
show ?thesis unfolding predict_stoch_proc_def
proof
show "arb_pf asset 0 ∈ borel_measurable (G 0)" using ‹arb_pf asset = (λ n w. - geom_proc 0 w)›
geometric_process by simp
show "∀n. arb_pf asset (Suc n) ∈ borel_measurable (G n)"
proof
fix n
show "arb_pf asset (Suc n) ∈ borel_measurable (G n)" using ‹arb_pf asset = (λ n w. - geom_proc 0 w)›
geometric_process by simp
qed
qed
qed
qed
show "∀w∈space M. cls_val_process Mkt arb_pf 0 w = 0"
proof
fix w
assume "w∈ space M"
have "cls_val_process Mkt arb_pf 0 w = geom_proc 0 w * arb_pf stk (Suc 0) w +
disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_vp_expand
‹stock_portfolio Mkt arb_pf›
using ‹self_financing Mkt arb_pf› self_financingE by fastforce
also have "... = geom_proc 0 w * (1) + disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w"
by (simp add: arb_pf_def two_stocks)
also have "... = geom_proc 0 w + arb_pf risk_free_asset (Suc 0) w" by simp
also have "... = geom_proc 0 w - geom_proc 0 w" unfolding arb_pf_def by simp
also have "... = 0" by simp
finally show "cls_val_process Mkt arb_pf 0 w = 0" .
qed
have dev: "∀w∈ space M. cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
proof (intro ballI)
fix w
assume "w∈ space M"
have "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w * arb_pf stk (Suc 0) w +
disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_uvp_expand
‹stock_portfolio Mkt arb_pf› by simp
also have "... = geom_proc (Suc 0) w + disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w"
by (simp add: arb_pf_def two_stocks)
also have "... = geom_proc (Suc 0) w + (1+r) * arb_pf risk_free_asset (Suc 0) w" by simp
also have "... = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w" by (simp add:arb_pf_def)
finally show "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w" .
qed
have iniT: "∀w∈ space M. snth w 0 ⟶ cls_val_process Mkt arb_pf (Suc 0) w > 0"
proof (intro ballI impI)
fix w
assume "w∈ space M" and "snth w 0"
have "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
using dev ‹w∈ space M› by simp
also have "... = u * geom_proc 0 w - (1+r) * geom_proc 0 w" using ‹snth w 0› geometric_process by simp
also have "... = (u - (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
also have "... > 0" using S0_positive ‹1 + r ≤ d› down_lt_up geometric_process by auto
finally show "cls_val_process Mkt arb_pf (Suc 0) w > 0" .
qed
have iniF: "∀w∈ space M. ¬snth w 0 ⟶ cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof (intro ballI impI)
fix w
assume "w∈ space M" and "¬snth w 0"
have "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
using dev ‹w∈ space M› by simp
also have "... = d * geom_proc 0 w - (1+r) * geom_proc 0 w" using ‹¬snth w 0› geometric_process by simp
also have "... = (d - (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
also have "... ≥ 0" using S0_positive ‹1 + r ≤ d› down_lt_up geometric_process by auto
finally show "cls_val_process Mkt arb_pf (Suc 0) w ≥ 0" .
qed
have "∀w∈ space M. cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof
fix w
assume "w∈ space M"
show "cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof (cases "snth w 0")
case True
thus ?thesis using ‹w∈ space M› iniT by auto
next
case False
thus ?thesis using ‹w∈ space M› iniF by simp
qed
qed
thus "AE w in M. 0 ≤ cls_val_process Mkt arb_pf (Suc 0) w" by simp
show "0 < prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}"
proof -
have "cls_val_process Mkt arb_pf (Suc 0) ∈ borel_measurable M" using borel_adapt_stoch_proc_borel_measurable
cls_val_process_adapted ‹trading_strategy arb_pf› ‹stock_portfolio Mkt arb_pf›
using support_adapt_def readable unfolding stock_portfolio_def by blast
hence set_event:"{w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w} ∈ sets M"
using borel_measurable_iff_greater by blast
have "∀n. emeasure M {w ∈ space M. w !! n} = ennreal p"
using bernoulli p_gt_0 p_lt_1 bernoulli_stream_component_probability[of M p]
by auto
hence "emeasure M {w ∈ space M. w !! 0} = ennreal p" by blast
moreover have "{w ∈ space M. w !! 0} ⊆ {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}"
proof
fix w
assume "w∈ {w ∈ space M. w !! 0}"
hence "w ∈ space M" and "w !! 0" by auto note wprops = this
hence "0 < cls_val_process Mkt arb_pf 1 w" using iniT by simp
thus "w∈ {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}" using wprops by simp
qed
ultimately have "p ≤ emeasure M {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}"
using emeasure_mono set_event by fastforce
hence "p ≤ prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}" by (simp add: emeasure_eq_measure)
thus "0 < prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}" using psgt by simp
qed
qed
thus False using assms unfolding viable_market_def using ‹stock_portfolio Mkt arb_pf› by simp
qed
lemma (in CRR_market) viable_only_if_u:
assumes "viable_market Mkt"
shows "1+r < u"
proof (rule ccontr)
assume "¬ 1+r < u"
hence "u ≤ 1+r" by simp
define arb_pf where "arb_pf = (λ (x::'a) (n::nat) w. 0::real)(stk:= (λ n w. -1), risk_free_asset := (λ n w. geom_proc 0 w))"
have "support_set arb_pf = {stk, risk_free_asset}"
proof
show "support_set arb_pf ⊆ {stk, risk_free_asset}"
by (simp add: arb_pf_def subset_iff support_set_def)
have "stk∈ support_set arb_pf" unfolding arb_pf_def support_set_def using two_stocks by simp
moreover have "risk_free_asset∈ support_set arb_pf" unfolding arb_pf_def support_set_def
using two_stocks geometric_process S0_positive by simp
ultimately show "{stk, risk_free_asset}⊆ support_set arb_pf" by simp
qed
hence "stock_portfolio Mkt arb_pf" using stocks
by (simp add: portfolio_def stock_portfolio_def)
have "arbitrage_process Mkt arb_pf"
proof (rule arbitrage_processI, intro exI conjI)
show "self_financing Mkt arb_pf" unfolding arb_pf_def using ‹support_set arb_pf = {stk, risk_free_asset}›
by (simp add: static_portfolio_self_financing)
show "trading_strategy arb_pf" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio arb_pf" unfolding portfolio_def using ‹support_set arb_pf = {stk, risk_free_asset}› by simp
fix asset
assume "asset∈ support_set arb_pf"
show "borel_predict_stoch_proc G (arb_pf asset)"
proof (cases "asset = stk")
case True
hence "arb_pf asset = (λ n w. -1)" unfolding arb_pf_def by (simp add: two_stocks)
show ?thesis unfolding predict_stoch_proc_def
proof
show "arb_pf asset 0 ∈ borel_measurable (G 0)" using ‹arb_pf asset = (λ n w. -1)› by simp
show "∀n. arb_pf asset (Suc n) ∈ borel_measurable (G n)"
proof
fix n
show "arb_pf asset (Suc n) ∈ borel_measurable (G n)" using ‹arb_pf asset = (λ n w. -1)› by simp
qed
qed
next
case False
hence "arb_pf asset = (λ n w. geom_proc 0 w)" using ‹support_set arb_pf = {stk, risk_free_asset}›
‹asset ∈ support_set arb_pf› unfolding arb_pf_def by simp
show ?thesis unfolding predict_stoch_proc_def
proof
show "arb_pf asset 0 ∈ borel_measurable (G 0)" using ‹arb_pf asset = (λ n w. geom_proc 0 w)›
geometric_process by simp
show "∀n. arb_pf asset (Suc n) ∈ borel_measurable (G n)"
proof
fix n
show "arb_pf asset (Suc n) ∈ borel_measurable (G n)" using ‹arb_pf asset = (λ n w. geom_proc 0 w)›
geometric_process by simp
qed
qed
qed
qed
show "∀w∈space M. cls_val_process Mkt arb_pf 0 w = 0"
proof
fix w
assume "w∈ space M"
have "cls_val_process Mkt arb_pf 0 w = geom_proc 0 w * arb_pf stk (Suc 0) w +
disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_vp_expand
‹stock_portfolio Mkt arb_pf›
using ‹self_financing Mkt arb_pf› self_financingE by fastforce
also have "... = geom_proc 0 w * (-1) + disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w"
by (simp add: arb_pf_def two_stocks)
also have "... = -geom_proc 0 w + arb_pf risk_free_asset (Suc 0) w" by simp
also have "... = geom_proc 0 w - geom_proc 0 w" unfolding arb_pf_def by simp
also have "... = 0" by simp
finally show "cls_val_process Mkt arb_pf 0 w = 0" .
qed
have dev: "∀w∈ space M. cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
proof (intro ballI)
fix w
assume "w∈ space M"
have "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w * arb_pf stk (Suc 0) w +
disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_uvp_expand
‹stock_portfolio Mkt arb_pf› by simp
also have "... = -geom_proc (Suc 0) w + disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w"
by (simp add: arb_pf_def two_stocks)
also have "... = -geom_proc (Suc 0) w + (1+r) * arb_pf risk_free_asset (Suc 0) w" by simp
also have "... = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w" by (simp add:arb_pf_def)
finally show "cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w" .
qed
have iniT: "∀w∈ space M. snth w 0 ⟶ cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof (intro ballI impI)
fix w
assume "w∈ space M" and "snth w 0"
have "cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
using dev ‹w∈ space M› by simp
also have "... = - u * geom_proc 0 w + (1+r) * geom_proc 0 w" using ‹snth w 0› geometric_process by simp
also have "... = (-u + (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
also have "... ≥ 0" using S0_positive ‹u≤ 1 + r› down_lt_up geometric_process by auto
finally show "cls_val_process Mkt arb_pf (Suc 0) w ≥ 0" .
qed
have iniF: "∀w∈ space M. ¬snth w 0 ⟶ cls_val_process Mkt arb_pf (Suc 0) w > 0"
proof (intro ballI impI)
fix w
assume "w∈ space M" and "¬snth w 0"
have "cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
using dev ‹w∈ space M› by simp
also have "... = -d * geom_proc 0 w + (1+r) * geom_proc 0 w" using ‹¬snth w 0› geometric_process by simp
also have "... = (-d + (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
also have "... > 0" using S0_positive ‹u <= 1 + r› down_lt_up geometric_process by auto
finally show "cls_val_process Mkt arb_pf (Suc 0) w > 0" .
qed
have "∀w∈ space M. cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof
fix w
assume "w∈ space M"
show "cls_val_process Mkt arb_pf (Suc 0) w ≥ 0"
proof (cases "snth w 0")
case True
thus ?thesis using ‹w∈ space M› iniT by simp
next
case False
thus ?thesis using ‹w∈ space M› iniF by auto
qed
qed
thus "AE w in M. 0 ≤ cls_val_process Mkt arb_pf (Suc 0) w" by simp
show "0 < prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}"
proof -
have "cls_val_process Mkt arb_pf (Suc 0) ∈ borel_measurable M" using borel_adapt_stoch_proc_borel_measurable
cls_val_process_adapted ‹trading_strategy arb_pf› ‹stock_portfolio Mkt arb_pf›
using support_adapt_def readable unfolding stock_portfolio_def by blast
hence set_event:"{w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w} ∈ sets M"
using borel_measurable_iff_greater by blast
have "∀n. emeasure M {w ∈ space M. ¬w !! n} = ennreal (1-p)"
using bernoulli p_gt_0 p_lt_1 bernoulli_stream_component_probability_compl[of M p]
by auto
hence "emeasure M {w ∈ space M. ¬w !! 0} = ennreal (1-p)" by blast
moreover have "{w ∈ space M. ¬w !! 0} ⊆ {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}"
proof
fix w
assume "w∈ {w ∈ space M. ¬w !! 0}"
hence "w ∈ space M" and "¬w !! 0" by auto note wprops = this
hence "0 < cls_val_process Mkt arb_pf 1 w" using iniF by simp
thus "w∈ {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}" using wprops by simp
qed
ultimately have "1-p ≤ emeasure M {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}"
using emeasure_mono set_event by fastforce
hence "1-p ≤ prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf 1 w}" by (simp add: emeasure_eq_measure)
thus "0 < prob {w ∈ space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}" using pslt by simp
qed
qed
thus False using assms unfolding viable_market_def using ‹stock_portfolio Mkt arb_pf› by simp
qed
lemma (in CRR_market) viable_iff:
shows "viable_market Mkt ⟷ (d < 1+r ∧ 1+r < u)" using viable_if viable_only_if_d viable_only_if_u by auto
subsection ‹Risk-neutral probability space for the geometric random walk›
lemma (in CRR_market) stock_price_borel_measurable:
shows "borel_adapt_stoch_proc G (prices Mkt stk)"
proof -
have "borel_adapt_stoch_proc (stoch_proc_filt M geom_proc borel) (prices Mkt stk)"
by (simp add: geom_rand_walk_borel_measurable stk_price stoch_proc_filt_adapt)
thus ?thesis by (simp add:stock_filtration)
qed
lemma (in CRR_market) risk_free_asset_martingale:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "martingale N G (discounted_value r (prices Mkt risk_free_asset))"
proof -
have "filtration N G" by (simp add: assms bernoulli_gen_filtration)
moreover have "∀n. sigma_finite_subalgebra N (G n)" by (simp add: assms bernoulli_sigma_finite)
moreover have "finite_measure N" using assms bernoulli_stream_def prob_space.prob_space_stream_space
prob_space_def prob_space_measure_pmf by auto
moreover have "discounted_value r (prices Mkt risk_free_asset) = (λ n w. 1)" using discounted_rfr by auto
ultimately show ?thesis using finite_measure.constant_martingale by simp
qed
lemma (in infinite_coin_toss_space) nat_filtration_from_eq_sets:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "sets (infinite_coin_toss_space.nat_filtration N n) = sets (nat_filtration n)"
proof -
have "sigma_sets (space (bernoulli_stream q)) {pseudo_proj_True n -` B ∩ space N |B. B ∈ sets (bernoulli_stream q)} = sigma_sets (space (bernoulli_stream p))
{pseudo_proj_True n -` B ∩ space M |B. B ∈ sets (bernoulli_stream p)}"
proof -
have "sets N = events"
by (metis assms(1) bernoulli_stream_def infinite_coin_toss_space_axioms infinite_coin_toss_space_def sets_measure_pmf sets_stream_space_cong)
then show ?thesis
using assms(1) bernoulli_stream_space infinite_coin_toss_space_axioms infinite_coin_toss_space_def by auto
qed
thus ?thesis using infinite_coin_toss_space.nat_filtration_sets
using assms(1) assms(2) assms(3) infinite_coin_toss_space_axioms infinite_coin_toss_space_def by auto
qed
lemma (in CRR_market) geom_proc_integrable:
assumes "N = bernoulli_stream q"
and "0 ≤ q"
and "q ≤ 1"
shows "integrable N (geom_proc n)"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms by unfold_locales
show "geom_proc n ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N n)" using geometric_process
prob_grw.geom_rand_walk_borel_adapted[of q N geom_proc u d init]
by (metis ‹infinite_coin_toss_space q N› geom_rand_walk_pseudo_proj_True infinite_coin_toss_space.nat_filtration_borel_measurable_characterization
prob_grw.geom_rand_walk_borel_measurable prob_grw_axioms prob_grw_def)
qed
lemma (in CRR_market) CRR_infinite_cts_filtration:
shows "infinite_cts_filtration p M nat_filtration"
by (unfold_locales, simp)
lemma (in CRR_market) proj_stoch_proc_geom_disc_fct:
shows "disc_fct (proj_stoch_proc geom_proc n)" unfolding disc_fct_def using CRR_infinite_cts_filtration
by (simp add: countable_finite geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_set_finite_range)
lemma (in CRR_market) proj_stoch_proc_geom_rng:
assumes "N = bernoulli_stream q"
shows "proj_stoch_proc geom_proc n ∈ N →⇩M stream_space borel"
proof -
have "random_variable (stream_space borel) (proj_stoch_proc geom_proc n)" using CRR_infinite_cts_filtration
using geom_rand_walk_borel_adapted nat_discrete_filtration proj_stoch_measurable_if_adapted by blast
then show ?thesis
using assms(1) bernoulli bernoulli_stream_def by auto
qed
lemma (in CRR_market) proj_stoch_proc_geom_open_set:
shows "∀r∈range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel).
∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
proof
fix r
assume "r∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)"
show "∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
proof
show "infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r ∈ sets (stream_space borel)"
using infinite_cts_filtration.stream_space_single_set ‹r ∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)›
geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
show "range (proj_stoch_proc geom_proc n) ∩ infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r = {r}"
using infinite_cts_filtration.stream_space_single_preimage ‹r ∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)›
geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
qed
qed
lemma (in CRR_market) bernoulli_AE_cond_exp:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "integrable N X"
shows "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof (rule finite_measure.charact_cond_exp')
have "infinite_cts_filtration p M nat_filtration"
by (unfold_locales, simp)
show "finite_measure N" using assms
by (simp add: bernoulli_stream_def prob_space.finite_measure prob_space.prob_space_stream_space prob_space_measure_pmf)
show "disc_fct (proj_stoch_proc geom_proc n)" using proj_stoch_proc_geom_disc_fct by simp
show "integrable N X" using assms by simp
show "proj_stoch_proc geom_proc n ∈ N →⇩M stream_space borel" using assms proj_stoch_proc_geom_rng by simp
show "∀r∈range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel).
∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
using proj_stoch_proc_geom_open_set by simp
qed
lemma (in CRR_market) geom_proc_cond_exp:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) (geom_proc (Suc n)) w =
expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_AE_cond_exp)
show "integrable N (geom_proc (Suc n))" using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)
lemma (in CRR_market) expl_cond_eq_sets:
assumes "N = bernoulli_stream q"
shows "expl_cond_expect N (proj_stoch_proc geom_proc n) X ∈
borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
proof (rule expl_cond_exp_borel)
show "proj_stoch_proc geom_proc n ∈ space N → space (stream_space borel)"
proof -
have "random_variable (stream_space borel) (proj_stoch_proc geom_proc n)"
using CRR_infinite_cts_filtration geom_rand_walk_borel_adapted proj_stoch_measurable_if_adapted
nat_discrete_filtration by blast
then show ?thesis
by (simp add: assms(1) bernoulli bernoulli_stream_space measurable_def)
qed
show "disc_fct (proj_stoch_proc geom_proc n)" unfolding disc_fct_def using CRR_infinite_cts_filtration
by (simp add: countable_finite geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_set_finite_range)
show "∀r∈range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel).
∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
proof
fix r
assume "r∈range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)"
show "∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
proof
show "infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r ∈ sets (stream_space borel)"
using infinite_cts_filtration.stream_space_single_set ‹r ∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)›
geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
show "range (proj_stoch_proc geom_proc n) ∩ infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r = {r}"
using infinite_cts_filtration.stream_space_single_preimage ‹r ∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)›
geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
qed
qed
qed
lemma (in CRR_market) bernoulli_real_cond_exp_AE:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "integrable N X"
shows "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof -
have "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
expl_cond_expect N (proj_stoch_proc geom_proc n) X w" using assms bernoulli_AE_cond_exp by simp
show "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
proof -
have "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X
∈ borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
by simp
moreover have "subalgebra (infinite_coin_toss_space.nat_filtration N n) (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
using stock_filtration infinite_coin_toss_space.stoch_proc_subalg_nat_filt[of q N geom_proc n]
infinite_cts_filtration.stoch_proc_filt_gen[of q N]
by (metis ‹infinite_coin_toss_space q N› infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
ultimately show ?thesis using measurable_from_subalg by blast
qed
show "expl_cond_expect N (proj_stoch_proc geom_proc n) X ∈
borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
proof -
have "expl_cond_expect N (proj_stoch_proc geom_proc n) X ∈
borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
by (simp add: expl_cond_eq_sets assms)
moreover have "subalgebra (infinite_coin_toss_space.nat_filtration N n) (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
using stock_filtration infinite_coin_toss_space.stoch_proc_subalg_nat_filt[of q N geom_proc n]
infinite_cts_filtration.stoch_proc_filt_gen[of q N]
by (metis ‹infinite_coin_toss_space q N› infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
ultimately show ?thesis using measurable_from_subalg by blast
qed
show "0 < q" and "q < 1" using assms by auto
qed
thus ?thesis by simp
qed
lemma (in CRR_market) geom_proc_real_cond_exp_AE:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
(geom_proc (Suc n)) w = expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_real_cond_exp_AE)
show "integrable N (geom_proc (Suc n))" using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)
lemma (in CRR_market) geom_proc_stoch_proc_filt:
assumes "N= bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "stoch_proc_filt N geom_proc borel n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
proof (rule infinite_cts_filtration.stoch_proc_filt_gen)
show "infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)" unfolding infinite_cts_filtration_def
proof
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "infinite_cts_filtration_axioms N (infinite_coin_toss_space.nat_filtration N)"
using infinite_cts_filtration_axioms_def by blast
qed
show "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) geom_proc"
using ‹infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)›
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def
using infinite_cts_filtration_def by auto
qed
lemma (in CRR_market) bernoulli_cond_exp:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "integrable N X"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof -
have aeq: "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
expl_cond_expect N (proj_stoch_proc geom_proc n) X w" using assms
bernoulli_AE_cond_exp by simp
have "∀w. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w" using assms bernoulli_real_cond_exp_AE by simp
moreover have "stoch_proc_filt N geom_proc borel n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
using assms geom_proc_stoch_proc_filt by simp
ultimately show ?thesis by simp
qed
lemma (in CRR_market) stock_cond_exp:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) (geom_proc (Suc n)) w = expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_cond_exp)
show "integrable N (geom_proc (Suc n))" using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)
lemma (in prob_space) discount_factor_real_cond_exp:
assumes "integrable M X"
and "subalgebra M G"
and "-1 < r"
shows "AE w in M. real_cond_exp M G (λx. discount_factor r n x * X x) w = discount_factor r n w * (real_cond_exp M G X) w"
proof (rule sigma_finite_subalgebra.real_cond_exp_mult)
show "sigma_finite_subalgebra M G" using assms subalgebra_sigma_finite by simp
show "discount_factor r n ∈ borel_measurable G" by (simp add: discount_factor_borel_measurable)
show "random_variable borel X" using assms by simp
show "integrable M (λx. discount_factor r n x * X x)" using assms discounted_integrable[of M "λn. X"]
unfolding discounted_value_def by simp
qed
lemma (in prob_space) discounted_value_real_cond_exp:
assumes "integrable M X"
and "-1 < r"
and "subalgebra M G"
shows "AE w in M. real_cond_exp M G ((discounted_value r (λ m. X)) n) w =
discounted_value r (λm. (real_cond_exp M G X)) n w" using assms
unfolding discounted_value_def init_triv_filt_def filtration_def
by (simp add: assms discount_factor_real_cond_exp)
lemma (in CRR_market)
assumes "q = (1 + r - d)/(u -d)"
and "viable_market Mkt"
shows gt_param: "0 < q"
and lt_param: "q < 1"
and risk_neutral_param: "u * q + d * (1 - q) = 1 + r"
proof -
show "0 < q" using down_lt_up viable_only_if_d assms by simp
show "q < 1" using down_lt_up viable_only_if_u assms by simp
show "u * q + d * (1 - q) = 1 + r"
proof -
have "1 - q = 1 - (1 + r - d) / (u - d)" using assms by simp
also have "... = (u - d)/(u - d) - (1 + r - d) / (u - d)" using down_lt_up by simp
also have "... = (u - d - (1 + r - d))/(u-d)" using diff_divide_distrib[of "u - d" "1 + r -d" "u -d"] by simp
also have "... = (u - 1 - r)/(u-d)" by simp
finally have "1 - q = (u - 1 - r)/(u -d)" .
hence "u * q + d * (1 - q) = u * (1 + r - d)/(u - d) + d * (u - 1 - r)/(u - d)" using assms by simp
also have "... = (u * (1 + r - d) + d * (u - 1 - r))/(u - d)" using add_divide_distrib[of "u * (1 + r - d)"] by simp
also have "... = (u * (1 + r) - u * d + d * u - d * (1 + r))/(u - d)"
by (simp add: diff_diff_add right_diff_distrib')
also have "... = (u * (1+r) - d * (1+r))/(u - d)" by simp
also have "... = ((u - d) * (1+r))/(u - d)" by (simp add: left_diff_distrib)
also have "... = 1 + r" using down_lt_up by simp
finally show ?thesis .
qed
qed
lemma (in CRR_market) bernoulli_expl_cond_expect_adapt:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "expl_cond_expect N (proj_stoch_proc geom_proc n) f∈ borel_measurable (G n)"
proof -
have "sets N = sets M" using assms by (simp add: bernoulli bernoulli_stream_def sets_stream_space_cong)
have icf: "infinite_cts_filtration p M nat_filtration" by (unfold_locales, simp)
have "G n = stoch_proc_filt M geom_proc borel n" using stock_filtration by simp
also have "... = fct_gen_subalgebra M (stream_space borel) (proj_stoch_proc geom_proc n)"
proof (rule infinite_cts_filtration.stoch_proc_filt_gen)
show "infinite_cts_filtration p M nat_filtration" using icf .
show "borel_adapt_stoch_proc nat_filtration geom_proc" using geom_rand_walk_borel_adapted .
qed
also have "... = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
by (rule fct_gen_subalgebra_eq_sets, (simp add: ‹sets N = sets M›))
finally have "G n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)" .
moreover have "expl_cond_expect N (proj_stoch_proc geom_proc n) f ∈
borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
by (simp add: expl_cond_eq_sets assms)
ultimately show ?thesis by simp
qed
lemma (in CRR_market) real_cond_exp_discount_stock:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "AE w in N. real_cond_exp N (G n)
(discounted_value r (prices Mkt stk) (Suc n)) w =
discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
proof -
have qlt: "0 < q" and qgt: "q < 1" using assms by auto
have "G n = (fct_gen_subalgebra M (stream_space borel)
(proj_stoch_proc geom_proc n))"
using stock_filtration infinite_cts_filtration.stoch_proc_filt_gen[of p M nat_filtration geom_proc n] geometric_process
geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by simp
also have "... = (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))"
proof (rule fct_gen_subalgebra_eq_sets)
show "events = sets N" using assms qlt qgt
by (simp add: bernoulli bernoulli_stream_def sets_stream_space_cong)
qed
finally have "G n = (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))" .
hence "AE w in N. real_cond_exp N (G n)
(discounted_value r (prices Mkt stk) (Suc n)) w = real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
(discounted_value r (prices Mkt stk) (Suc n)) w" by simp
moreover have "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
(discounted_value r (prices Mkt stk) (Suc n)) w =
real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
(discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n)) w"
proof -
have "∀w. (discounted_value r (prices Mkt stk) (Suc n)) w =
(discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n)) w"
proof
fix w
show "discounted_value r (prices Mkt stk) (Suc n) w = discounted_value r (λm. prices Mkt stk (Suc n)) (Suc n) w"
by (simp add: discounted_value_def)
qed
hence "(discounted_value r (prices Mkt stk) (Suc n)) =
(discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n))" by auto
thus ?thesis by simp
qed
moreover have "AE w in N. (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
(discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n))) w =
discounted_value r (λm. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
((prices Mkt stk) (Suc n))) (Suc n) w"
proof (rule prob_space.discounted_value_real_cond_exp)
show "-1 < r" using acceptable_rate by simp
show "integrable N (prices Mkt stk (Suc n))" using stk_price geom_proc_integrable assms qlt qgt by simp
show "subalgebra N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
proof (rule fct_gen_subalgebra_is_subalgebra)
show "proj_stoch_proc geom_proc n ∈ N →⇩M stream_space borel"
proof -
have "proj_stoch_proc geom_proc n ∈ measurable M (stream_space borel)"
proof (rule proj_stoch_measurable_if_adapted)
show "borel_adapt_stoch_proc nat_filtration geom_proc" using
geometric_process
geom_rand_walk_borel_adapted by simp
show "filtration M nat_filtration" using CRR_infinite_cts_filtration
by (simp add: nat_discrete_filtration)
qed
thus ?thesis using assms bernoulli_stream_equiv filt_equiv_measurable qlt qgt psgt pslt by blast
qed
qed
show "prob_space N" using assms
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
qed
moreover have "AE w in N. discounted_value r (λm. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
((prices Mkt stk) (Suc n))) (Suc n) w =
discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
proof (rule discounted_AE_cong)
have "AEeq N (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
((prices Mkt stk) (Suc n)))
(λw. q * (prices Mkt stk) (Suc n) (pseudo_proj_True n w) +
(1 - q) * (prices Mkt stk) (Suc n) (pseudo_proj_False n w))"
proof (rule infinite_cts_filtration.f_borel_Suc_real_cond_exp)
show icf: "infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)" unfolding infinite_cts_filtration_def
proof
show "infinite_coin_toss_space q N" using assms qlt qgt
by (simp add: infinite_coin_toss_space_def)
show "infinite_cts_filtration_axioms N (infinite_coin_toss_space.nat_filtration N)"
using infinite_cts_filtration_axioms_def by blast
qed
have badapt: "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) (prices Mkt stk)"
using stk_price prob_grw.geom_rand_walk_borel_adapted[of q N geom_proc]
unfolding adapt_stoch_proc_def
by (metis (full_types) borel_measurable_integrable geom_proc_integrable geom_rand_walk_pseudo_proj_True icf
infinite_coin_toss_space.nat_filtration_borel_measurable_characterization infinite_coin_toss_space_def
infinite_cts_filtration_def)
show "prices Mkt stk (Suc n) ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (Suc n))"
using badapt unfolding adapt_stoch_proc_def by simp
show "proj_stoch_proc geom_proc n ∈ infinite_coin_toss_space.nat_filtration N n →⇩M stream_space borel"
proof (rule proj_stoch_adapted_if_adapted)
show "filtration N (infinite_coin_toss_space.nat_filtration N)" using icf
using infinite_coin_toss_space.nat_discrete_filtration infinite_cts_filtration_def by blast
show "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) geom_proc" using badapt stk_price by simp
qed
show "set_discriminating n (proj_stoch_proc geom_proc n) (stream_space borel)" unfolding set_discriminating_def
proof (intro allI impI)
fix w
assume "proj_stoch_proc geom_proc n w ≠ proj_stoch_proc geom_proc n (pseudo_proj_True n w)"
hence False using CRR_infinite_cts_filtration
by (metis ‹proj_stoch_proc geom_proc n w ≠ proj_stoch_proc geom_proc n (pseudo_proj_True n w)›
geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_proj_invariant)
thus "∃A∈sets (stream_space borel).
(proj_stoch_proc geom_proc n w ∈ A) = (proj_stoch_proc geom_proc n (pseudo_proj_True n w) ∉ A)" by simp
qed
show "∀w. proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w} ∈
sets (infinite_coin_toss_space.nat_filtration N n)"
proof
fix w
show "proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w} ∈ sets (infinite_coin_toss_space.nat_filtration N n)"
using ‹proj_stoch_proc geom_proc n ∈ infinite_coin_toss_space.nat_filtration N n →⇩M stream_space borel›
using assms geom_rand_walk_borel_adapted nat_filtration_from_eq_sets qlt qgt
infinite_cts_filtration.proj_stoch_singleton_set CRR_infinite_cts_filtration by blast
qed
show "∀r∈range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel).
∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}"
proof
fix r
assume asm: "r ∈ range (proj_stoch_proc geom_proc n) ∩ space (stream_space borel)"
define A where "A = infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r"
have "A ∈ sets (stream_space borel)" using infinite_cts_filtration.stream_space_single_set
unfolding A_def using badapt icf stk_price asm by blast
moreover have "range (proj_stoch_proc geom_proc n) ∩ A = {r}"
unfolding A_def using badapt icf stk_price infinite_cts_filtration.stream_space_single_preimage asm by blast
ultimately show "∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc n) ∩ A = {r}" by auto
qed
show "∀y z. proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n ⟶
prices Mkt stk (Suc n) y = prices Mkt stk (Suc n) z"
proof (intro allI impI)
fix y z
assume "proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n"
hence "geom_proc n y = geom_proc n z" using proj_stoch_proc_component(2)[of n n]
proof -
show ?thesis
by (metis ‹⋀w f. n ≤ n ⟹ proj_stoch_proc f n w !! n = f n w› ‹proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n› order_refl)
qed
hence "geom_proc (Suc n) y = geom_proc (Suc n) z" using geometric_process
by (simp add: ‹proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n›)
thus "prices Mkt stk (Suc n) y = prices Mkt stk (Suc n) z" using stk_price by simp
qed
show "0 < q" and "q < 1" using assms by auto
qed
moreover have "∀w. q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
(q * u + (1 - q) * d) * prices Mkt stk n w"
proof
fix w
have "q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
q * geom_proc (Suc n) (pseudo_proj_True n w) + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
by (simp add:stk_price)
also have "... = q * u * geom_proc n (pseudo_proj_True n w) + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
using geometric_process unfolding pseudo_proj_True_def by simp
also have "... = q * u * geom_proc n w + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
by (metis geom_rand_walk_pseudo_proj_True o_apply)
also have "... = q * u * geom_proc n w + (1-q) * d * geom_proc n (pseudo_proj_False n w)"
using geometric_process unfolding pseudo_proj_False_def by simp
also have "... = q * u * geom_proc n w + (1-q) * d * geom_proc n w"
by (metis geom_rand_walk_pseudo_proj_False o_apply)
also have "... = (q * u + (1 - q) * d) * geom_proc n w" by (simp add: distrib_right)
finally show "q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
(q * u + (1 - q) * d) * prices Mkt stk n w" using stk_price by simp
qed
ultimately show "AEeq N (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
(proj_stoch_proc geom_proc n))
((prices Mkt stk) (Suc n)))
(λw. (q * u + (1 - q) * d) * prices Mkt stk n w)" by simp
qed
ultimately show ?thesis by auto
qed
lemma (in CRR_market) risky_asset_martingale_only_if:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "martingale N G (discounted_value r (prices Mkt stk))"
shows "q = (1 + r - d) / (u - d)"
proof -
have "AE w in N. real_cond_exp N (G 0)
(discounted_value r (prices Mkt stk) (Suc 0)) w = discounted_value r (prices Mkt stk) 0 w" using assms
unfolding martingale_def by simp
hence "AE w in N. real_cond_exp N (G 0)
(discounted_value r (prices Mkt stk) (Suc 0)) w = prices Mkt stk 0 w" by (simp add: discounted_init)
moreover have "AE w in N. real_cond_exp N (G 0) (discounted_value r (prices Mkt stk) (Suc 0)) w =
discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk 0 w) (Suc 0) w"
using assms real_cond_exp_discount_stock by simp
ultimately have "AE w in N. discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk 0 w) (Suc 0) w =
prices Mkt stk 0 w" by auto
hence "AE w in N. discounted_value r (λm w. (q * u + (1 - q) * d) * init) (Suc 0) w =
(λw. init) w" using stk_price geometric_process by simp
hence "AE w in N. discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init =
(λw. init) w" unfolding discounted_value_def by simp
hence "AE w in N. (1+r) * discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init =
(1+r) * (λw. init) w" by auto
hence prev: "AE w in N. discount_factor r 0 w * (q * u + (1 - q) * d) * init =
(1+r) * (λw. init) w" using discount_factor_times_rfr[of r 0] acceptable_rate
proof -
have "∀s. (1 + r) * discount_factor r (Suc 0) (s::bool stream) = discount_factor r 0 s"
by (metis (no_types) ‹⋀w. - 1 < r ⟹ (1 + r) * discount_factor r (Suc 0) w = discount_factor r 0 w› acceptable_rate)
then show ?thesis
using ‹AEeq N (λw. (1 + r) * discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init) (λw. (1 + r) * init)› by presburger
qed
hence "∀w. (λw. discount_factor r 0 w * (q * u + (1 - q) * d) * init) w =
(λw. (1+r) * init) w"
proof -
have "(λw. discount_factor r 0 w * (q * u + (1 - q) * d) * init)
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N 0)"
proof (rule borel_measurable_times)+
show "(λx. init) ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
show "(λx. q * u + (1 - q) * d) ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
show "discount_factor r 0 ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N 0)"
using discount_factor_nonrandom[of r 0 "infinite_coin_toss_space.nat_filtration N 0"] by simp
qed
moreover have "(λw. (1 + r) * init) ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
moreover have "infinite_coin_toss_space q N" using assms by (simp add: infinite_coin_toss_space_def)
ultimately show ?thesis
using prev infinite_coin_toss_space.nat_filtration_AE_eq[of q N
"(λw. discount_factor r 0 w * (q * u + (1 - q) * d) * init)" "(λw. (1 + r) * init)" 0] assms
by (simp add: discount_factor_init)
qed
hence "(q * u + (1 - q) * d) * init = (1+r) * init" by (simp add: discount_factor_init)
hence "q * u + (1 - q) * d = 1+r" using S0_positive by simp
hence "q * u + d - q * d = 1+r" by (simp add: left_diff_distrib)
hence "q * (u - d) = 1 + r - d"
by (metis (no_types, hide_lams) add.commute add.left_commute add_diff_cancel_left' add_uminus_conv_diff left_diff_distrib mult.commute)
thus "q = (1 + r - d) / (u - d)" using down_lt_up
by (metis add.commute add.right_neutral diff_add_cancel nonzero_eq_divide_eq order_less_irrefl)
qed
locale CRR_market_viable = CRR_market +
assumes CRR_viable: "viable_market Mkt"
lemma (in CRR_market_viable) real_cond_exp_discount_stock_q_const:
assumes "N = bernoulli_stream q"
and "q = (1+r-d) / (u-d)"
shows "AE w in N. real_cond_exp N (G n)
(discounted_value r (prices Mkt stk) (Suc n)) w =
discounted_value r (prices Mkt stk) n w"
proof -
have qlt: "0 < q" and qgt: "q < 1" using assms gt_param lt_param CRR_viable by auto
have "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
using assms real_cond_exp_discount_stock[of N q] qlt qgt by simp
moreover have "∀w. (q * u + (1 - q) * d) * prices Mkt stk n w =
(1+r) * prices Mkt stk n w" using risk_neutral_param assms CRR_viable
by (simp add: mult.commute)
ultimately have "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w" by simp
moreover have "∀w∈ space N. discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w =
discounted_value r (λm w. prices Mkt stk n w) n w"
using acceptable_rate by (simp add:discounted_mult_times_rfr)
moreover hence "∀w∈ space N. discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w =
discounted_value r (prices Mkt stk) n w"
using acceptable_rate by (simp add:discounted_value_def)
ultimately show "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
discounted_value r (prices Mkt stk) n w" by simp
qed
lemma (in CRR_market_viable) risky_asset_martingale_if:
assumes "N = bernoulli_stream q"
and "q = (1 + r - d) / (u - d)"
shows "martingale N G (discounted_value r (prices Mkt stk))"
proof (rule disc_martingale_charact)
have qlt: "0 < q" and qgt: "q < 1" using assms gt_param lt_param CRR_viable by auto
show "∀n. integrable N (discounted_value r (prices Mkt stk) n)"
proof
fix n
show "integrable N (discounted_value r (prices Mkt stk) n)"
proof (rule discounted_integrable)
show "space N = space M" using assms by (simp add: bernoulli bernoulli_stream_space)
show "integrable N (prices Mkt stk n)"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms qlt qgt
by (simp add: infinite_coin_toss_space_def)
show "prices Mkt stk n ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
using geom_rand_walk_borel_adapted stk_price nat_filtration_from_eq_sets unfolding adapt_stoch_proc_def
by (metis ‹infinite_coin_toss_space q N› borel_measurable_integrable geom_proc_integrable geom_rand_walk_pseudo_proj_True
infinite_coin_toss_space.nat_filtration_borel_measurable_characterization infinite_coin_toss_space_def)
qed
show "-1 < r" using acceptable_rate by simp
qed
qed
show "filtration N G" using qlt qgt by (simp add: bernoulli_gen_filtration assms)
show "∀n. sigma_finite_subalgebra N (G n)" using qlt qgt by (simp add: assms bernoulli_sigma_finite)
show "∀m. discounted_value r (prices Mkt stk) m ∈ borel_measurable (G m)"
proof
fix m
have "discounted_value r (λma. prices Mkt stk m) m ∈ borel_measurable (G m)"
proof (rule discounted_measurable)
show "prices Mkt stk m ∈ borel_measurable (G m)" using stock_price_borel_measurable
unfolding adapt_stoch_proc_def by simp
qed
thus "discounted_value r (prices Mkt stk) m ∈ borel_measurable (G m)"
by (metis (mono_tags, lifting) discounted_value_def measurable_cong)
qed
show "∀n. AE w in N. real_cond_exp N (G n)
(discounted_value r (prices Mkt stk) (Suc n)) w = discounted_value r (prices Mkt stk) n w"
proof
fix n
show "AE w in N. real_cond_exp N (G n)
(discounted_value r (prices Mkt stk) (Suc n)) w = discounted_value r (prices Mkt stk) n w"
using assms real_cond_exp_discount_stock_q_const by simp
qed
qed
lemma (in CRR_market_viable) risk_neutral_iff':
assumes "N = bernoulli_stream q"
and "0 ≤ q"
and "q ≤ 1"
and "filt_equiv nat_filtration M N"
shows "rfr_disc_equity_market.risk_neutral_prob G Mkt r N ⟷ q= (1 + r - d) / (u - d)"
proof
have "0 < q" and "q < 1" using assms filt_equiv_sgt filt_equiv_slt psgt pslt by auto note qprops = this
have dem: "rfr_disc_equity_market M G Mkt r risk_free_asset" by unfold_locales
{
assume "rfr_disc_equity_market.risk_neutral_prob G Mkt r N"
hence "(prob_space N) ∧ (∀ asset ∈ stocks Mkt. martingale N G (discounted_value r (prices Mkt asset)))"
using rfr_disc_equity_market.risk_neutral_prob_def[of M G Mkt] dem by simp
hence "martingale N G (discounted_value r (prices Mkt stk))" using stocks by simp
thus "q = (1 + r - d) / (u - d)" using assms risky_asset_martingale_only_if[of N q] qprops by simp
}
{
assume "q = (1 + r - d) / (u - d)"
hence "martingale N G (discounted_value r (prices Mkt stk))" using risky_asset_martingale_if[of N q] assms by simp
moreover have "martingale N G (discounted_value r (prices Mkt risk_free_asset))" using risk_free_asset_martingale
assms qprops by simp
ultimately show "rfr_disc_equity_market.risk_neutral_prob G Mkt r N" using stocks
using assms(1) bernoulli_stream_def dem prob_space.prob_space_stream_space prob_space_measure_pmf
rfr_disc_equity_market.risk_neutral_prob_def by fastforce
}
qed
lemma (in CRR_market_viable) risk_neutral_iff:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "rfr_disc_equity_market.risk_neutral_prob G Mkt r N ⟷ q= (1 + r - d) / (u - d)"
using bernoulli_stream_equiv assms risk_neutral_iff' psgt pslt by auto
subsection ‹Existence of a replicating portfolio›
fun (in CRR_market) rn_rev_price where
"rn_rev_price N der matur 0 w = der w" |
"rn_rev_price N der matur (Suc n) w = discount_factor r (Suc 0) w *
expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w"
lemma (in CRR_market) stock_filtration_eq:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "G n = stoch_proc_filt N geom_proc borel n"
proof -
have "G n= stoch_proc_filt M geom_proc borel n" using stock_filtration by simp
also have "... = stoch_proc_filt N geom_proc borel n"
proof (rule stoch_proc_filt_filt_equiv)
show "filt_equiv nat_filtration M N" using assms bernoulli_stream_equiv psgt pslt by simp
qed
finally show ?thesis .
qed
lemma (in CRR_market) real_exp_eq:
assumes "der∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) der w =
expl_cond_expect N (proj_stoch_proc geom_proc n) der w"
proof -
have "der ∈ borel_measurable (nat_filtration matur)" using assms
using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
have "integrable N der"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "der ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
by (metis ‹der ∈ borel_measurable (nat_filtration matur)› ‹infinite_coin_toss_space q N›
assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
qed
show "real_cond_exp N (stoch_proc_filt N geom_proc borel n) der w =
expl_cond_expect N (proj_stoch_proc geom_proc n) der w"
proof (rule bernoulli_cond_exp)
show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
show "integrable N der" using ‹integrable N der› .
qed
qed
lemma (in CRR_market) rn_rev_price_rev_borel_adapt:
assumes "cash_flow ∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "(n ≤ matur) ⟹ (rn_rev_price N cash_flow matur n) ∈ borel_measurable (G (matur - n))"
proof (induct n)
case 0 thus ?case using assms by simp
next
case (Suc n)
have "rn_rev_price N cash_flow matur (Suc n) =
(λw. discount_factor r (Suc 0) w *
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N cash_flow matur n)) w)"
using rn_rev_price.simps(2) by blast
also have "... ∈ borel_measurable (G (matur - Suc n))"
proof (rule borel_measurable_times)
show "discount_factor r (Suc 0) ∈ borel_measurable (G (matur - Suc n))" by (simp add:discount_factor_borel_measurable)
show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N cash_flow matur n)
∈ borel_measurable (G (matur - Suc n))" using assms by (simp add: bernoulli_expl_cond_expect_adapt)
qed
finally show "rn_rev_price N cash_flow matur (Suc n) ∈ borel_measurable (G (matur - Suc n))" .
qed
lemma (in infinite_coin_toss_space) bernoulli_discounted_integrable:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "der ∈ borel_measurable (nat_filtration n)"
and "-1 < r"
shows "integrable N (discounted_value r (λm. der) m)"
proof -
have "prob_space N" using assms
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
have "integrable N der"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "der ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
using assms filt_equiv_filtration
by (simp add: assms(1) measurable_def nat_filtration_from_eq_sets nat_filtration_space)
qed
thus ?thesis using discounted_integrable assms
by (metis ‹prob_space N› prob_space.discounted_integrable)
qed
lemma (in CRR_market) rn_rev_expl_cond_expect:
assumes "der∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "n ≤ matur ⟹ rn_rev_price N der matur n w =
expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n) w"
proof (induct n arbitrary: w)
case 0
have "der ∈ borel_measurable (nat_filtration matur)" using assms
using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
have "integrable N der"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "der ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
by (metis ‹der ∈ borel_measurable (nat_filtration matur)› ‹infinite_coin_toss_space q N›
assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
qed
have "rn_rev_price N der matur 0 w = der w" by simp
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0) w"
proof (rule nat_filtration_AE_eq)
show "der ∈ borel_measurable (nat_filtration matur)" using ‹der ∈ borel_measurable (nat_filtration matur)› .
have "(discounted_value r (λm. der) 0) = der" unfolding discounted_value_def discount_factor_def by simp
moreover have "AEeq N (real_cond_exp N (G matur) der) der"
proof (rule sigma_finite_subalgebra.real_cond_exp_F_meas)
show "der ∈ borel_measurable (G matur)" using assms by simp
show "integrable N der" using ‹integrable N der› .
show "sigma_finite_subalgebra N (G matur)" using bernoulli_sigma_finite
using assms by simp
qed
moreover have "∀w. real_cond_exp N (stoch_proc_filt N geom_proc borel matur) der w =
expl_cond_expect N (proj_stoch_proc geom_proc matur) der w" using assms real_exp_eq by simp
ultimately have eqn: "AEeq N der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
using stock_filtration_eq assms by auto
have "stoch_proc_filt M geom_proc borel matur = stoch_proc_filt N geom_proc borel matur"
using bernoulli_stream_equiv[of N q] assms psgt pslt by (simp add: stoch_proc_filt_filt_equiv)
also have "stoch_proc_filt N geom_proc borel matur =
fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur)"
using assms geom_proc_stoch_proc_filt by simp
finally have "stoch_proc_filt M geom_proc borel matur =
fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur)" .
moreover have "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
∈ borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur))"
proof (rule expl_cond_exp_borel)
show "proj_stoch_proc geom_proc matur ∈ space N → space (stream_space borel)"
using assms proj_stoch_proc_geom_rng by (simp add: measurable_def)
show "disc_fct (proj_stoch_proc geom_proc matur)" using proj_stoch_proc_geom_disc_fct by simp
show "∀r∈range (proj_stoch_proc geom_proc matur) ∩ space (stream_space borel).
∃A∈sets (stream_space borel). range (proj_stoch_proc geom_proc matur) ∩ A = {r}"
using proj_stoch_proc_geom_open_set by simp
qed
ultimately show ebm: "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
∈ borel_measurable (nat_filtration matur)"
by (metis geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt)
show "AEeq M der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
proof (rule filt_equiv_borel_AE_eq_iff[THEN iffD2])
show "filt_equiv nat_filtration M N" using assms bernoulli_stream_equiv psgt pslt by simp
show "der ∈ borel_measurable (nat_filtration matur)" using ‹der ∈ borel_measurable (nat_filtration matur)› .
show "AEeq N der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
using eqn .
show "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
∈ borel_measurable (nat_filtration matur)" using ebm .
show "prob_space N" using assms by (simp add: bernoulli_stream_def
prob_space.prob_space_stream_space prob_space_measure_pmf)
show "prob_space M" by (simp add: bernoulli bernoulli_stream_def
prob_space.prob_space_stream_space prob_space_measure_pmf)
qed
show "0 < p" "p < 1" using psgt pslt by auto
qed
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - 0)) (discounted_value r (λm. der) 0) w"
by simp
finally show "rn_rev_price N der matur 0 w =
expl_cond_expect N (proj_stoch_proc geom_proc (matur - 0)) (discounted_value r (λm. der) 0) w" .
next
case (Suc n)
have "rn_rev_price N der matur (Suc n) w = discount_factor r (Suc 0) w *
expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w" by simp
also have "... = discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w"
proof -
have "expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w =
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w"
proof (rule real_exp_eq[symmetric])
show "rn_rev_price N der matur n ∈ borel_measurable (G (matur - n))"
using assms rn_rev_price_rev_borel_adapt Suc by simp
show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
qed
thus ?thesis by simp
qed
also have "... = discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w"
proof -
have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w =
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w"
proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
show "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)))"
proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
show "rn_rev_price N der matur n ∈ borel_measurable N"
proof -
have "rn_rev_price N der matur n ∈ borel_measurable (G (matur - n))"
by (metis (full_types) Suc.prems Suc_leD assms(1) assms(2) assms(3) assms(4) rn_rev_price_rev_borel_adapt)
then show ?thesis
by (metis (no_types) assms(2) bernoulli bernoulli_stream_def filtration_measurable measurable_cong_sets sets_measure_pmf sets_stream_space_cong)
qed
show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n) ∈ borel_measurable N"
using Suc.hyps Suc.prems Suc_leD ‹rn_rev_price N der matur n ∈ borel_measurable N› by presburger
show "AEeq N (rn_rev_price N der matur n)
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))" using Suc by auto
qed
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n)
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
show "0 < q" "q < 1" using assms by auto
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
qed
thus ?thesis by simp
qed
also have "... = discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
proof -
have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w =
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
show "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)))"
proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n) ∈ borel_measurable N"
by simp
show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n) ∈ borel_measurable N"
by (metis assms(2) assms(3) assms(4) bernoulli bernoulli_expl_cond_expect_adapt bernoulli_stream_def filtration_measurable
measurable_cong_sets sets_measure_pmf sets_stream_space_cong)
show "AEeq N (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))"
proof -
have "discounted_value r (λm. der) n ∈ borel_measurable (G matur)" using assms discounted_measurable[of der]
by simp
hence "∀w. (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w =
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
using real_exp_eq[of _ matur N q "matur-n"] assms by simp
thus ?thesis by simp
qed
qed
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
show "0 < q" "q < 1" using assms by auto
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
qed
thus ?thesis by simp
qed
also have "... = real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(discounted_value r (λm. der) (Suc n)) w"
proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) (Suc n))
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
show "(λa. discount_factor r (Suc 0) a *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) a)
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
proof -
have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))
∈ borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
thus ?thesis using discounted_measurable[of "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))"]
unfolding discounted_value_def by simp
qed
show "0 < q" "q < 1" using assms by auto
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "AEeq N (λw. discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w)
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) (Suc n)))"
proof-
have "AEeq N
(λw. discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w)
(λw. discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n) w)"
proof -
have "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)))
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n))"
proof (rule sigma_finite_subalgebra.real_cond_exp_nested_subalg)
show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
stock_filtration_eq by fastforce
show "subalgebra (stoch_proc_filt N geom_proc borel (matur - n)) (stoch_proc_filt N geom_proc borel (matur - Suc n))"
proof -
have "init_triv_filt M (stoch_proc_filt M geom_proc borel)" using infinite_cts_filtration.stoch_proc_filt_triv_init
using info_filtration stock_filtration by auto
moreover have "matur - (Suc n) ≤ matur - n" by simp
ultimately show ?thesis unfolding init_triv_filt_def filtration_def
using assms(2) assms(3) assms(4) stock_filtration stock_filtration_eq by auto
qed
show "integrable N (discounted_value r (λm. der) n) " using bernoulli_discounted_integrable[of N q der matur r n] acceptable_rate assms
using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
qed
thus ?thesis by auto
qed
moreover have "AEeq N
(λw. discount_factor r (Suc 0) w *
real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n) w)
(λw. discount_factor r (Suc 0) w * (discounted_value r
(λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n) w)"
proof -
have "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n))
(discounted_value r
(λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n)"
proof (rule prob_space.discounted_value_real_cond_exp)
show "prob_space N" using assms
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
have "der ∈ borel_measurable (nat_filtration matur)" using assms
using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
show "integrable N der"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "der ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
by (metis ‹der ∈ borel_measurable (nat_filtration matur)› ‹infinite_coin_toss_space q N›
assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
qed
show "-1 < r" using acceptable_rate .
show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
stock_filtration_eq by fastforce
qed
thus ?thesis by auto
qed
moreover have "∀w. (λw. discount_factor r (Suc 0) w * (discounted_value r
(λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n) w) w =
(discounted_value r
(λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) (Suc n)) w"
unfolding discounted_value_def discount_factor_def by simp
moreover have "AEeq N
(real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
(discounted_value r (λm. der) (Suc n)))
(discounted_value r
(λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) (Suc n))"
proof (rule prob_space.discounted_value_real_cond_exp)
show "prob_space N" using assms
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
have "der ∈ borel_measurable (nat_filtration matur)" using assms
using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
show "integrable N der"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
show "infinite_coin_toss_space q N" using assms
by (simp add: infinite_coin_toss_space_def)
show "der ∈ borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
by (metis ‹der ∈ borel_measurable (nat_filtration matur)› ‹infinite_coin_toss_space q N›
assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
qed
show "-1 < r" using acceptable_rate .
show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
stock_filtration_eq by fastforce
qed
ultimately show ?thesis by auto
qed
qed
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n))
(discounted_value r (λm. der) (Suc n)) w"
proof (rule real_exp_eq)
show "discounted_value r (λm. der) (Suc n) ∈ borel_measurable (G matur)" using assms discounted_measurable[of der]
by simp
show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
qed
finally show "rn_rev_price N der matur (Suc n) w =
expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (discounted_value r (λm. der) (Suc n)) w" .
qed
definition (in CRR_market) rn_price where
"rn_price N der matur n w = expl_cond_expect N (proj_stoch_proc geom_proc n) (discounted_value r (λm. der) (matur - n)) w"
definition (in CRR_market) rn_price_ind where
"rn_price_ind N der matur n w = rn_rev_price N der matur (matur - n) w"
lemma (in CRR_market) rn_price_eq:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "der ∈ borel_measurable (G matur)"
and "n ≤ matur"
shows "rn_price N der matur n w = rn_price_ind N der matur n w" using rn_rev_expl_cond_expect
unfolding rn_price_def rn_price_ind_def
by (simp add: assms)
lemma (in CRR_market) geom_proc_filt_info:
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f ∈ borel_measurable (G n)"
shows "f w = f (pseudo_proj_True n w)"
proof -
have "subalgebra (nat_filtration n) (G n)" using stoch_proc_subalg_nat_filt[of geom_proc n] geometric_process
stock_filtration geom_rand_walk_borel_adapted by simp
hence "f∈ borel_measurable (nat_filtration n)" using assms by (simp add: measurable_from_subalg)
thus ?thesis using nat_filtration_info[of f n] by (metis comp_apply)
qed
lemma (in CRR_market) geom_proc_filt_info':
fixes f::"bool stream ⇒ 'b::{t0_space}"
assumes "f ∈ borel_measurable (G n)"
shows "f w = f (pseudo_proj_False n w)"
proof -
have "subalgebra (nat_filtration n) (G n)" using stoch_proc_subalg_nat_filt[of geom_proc n] geometric_process
stock_filtration geom_rand_walk_borel_adapted by simp
hence "f∈ borel_measurable (nat_filtration n)" using assms by (simp add: measurable_from_subalg)
thus ?thesis using nat_filtration_info'[of f n] by (metis comp_apply)
qed
lemma (in CRR_market) rn_price_borel_adapt:
assumes "cash_flow ∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "n ≤ matur"
shows "(rn_price N cash_flow matur n) ∈ borel_measurable (G n)"
proof -
show "(rn_price N cash_flow matur n) ∈ borel_measurable (G n)"
using assms rn_rev_price_rev_borel_adapt[of cash_flow matur N q "matur - n"] rn_price_eq rn_price_ind_def
by (smt add.right_neutral cancel_comm_monoid_add_class.diff_cancel diff_commute diff_le_self
increasing_measurable_info measurable_cong nat_le_linear ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
qed
definition (in CRR_market) delta_price where
"delta_price N cash_flow T =
(λ n w. if (Suc n ≤ T)
then (rn_price N cash_flow T (Suc n) (pseudo_proj_True n w) - rn_price N cash_flow T (Suc n) (pseudo_proj_False n w))/
(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False))
else 0)"
lemma (in CRR_market) delta_price_eq:
assumes "Suc n ≤ T"
shows "delta_price N cash_flow T n w = (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
((geom_proc n w) * (u - d))"
proof -
have "(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = geom_proc n w * (u - d)"
by (simp add: geom_rand_walk_diff_induct)
then show ?thesis unfolding delta_price_def using assms spick_eq_pseudo_proj_True spick_eq_pseudo_proj_False by simp
qed
lemma (in CRR_market) geom_proc_spick:
shows "geom_proc (Suc n) (spick w n x) = (if x then u else d) * geom_proc n w"
proof -
have "geom_proc (Suc n) (spick w n x) = geom_rand_walk u d init (Suc n) (spick w n x)" using geometric_process by simp
also have "... = (case (spick w n x) !! n of True ⇒ u | False ⇒ d) * geom_rand_walk u d init n (spick w n x)"
by simp
also have "... = (case x of True ⇒ u | False ⇒ d) * geom_rand_walk u d init n (spick w n x)"
unfolding spick_def by simp
also have "... = (if x then u else d) * geom_rand_walk u d init n (spick w n x)" by simp
also have "... = (if x then u else d) * geom_rand_walk u d init n w"
by (metis comp_def geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
finally show ?thesis using geometric_process by simp
qed
lemma (in CRR_market) spick_red_geom:
shows "(λw. spick w n x) ∈ measurable (fct_gen_subalgebra M borel (geom_proc n)) (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
unfolding measurable_def
proof (intro CollectI conjI)
show "(λw. spick w n x)
∈ space (fct_gen_subalgebra M borel (geom_proc n)) → space (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
by (simp add: bernoulli bernoulli_stream_space fct_gen_subalgebra_space)
show "∀y∈sets (fct_gen_subalgebra M borel (geom_proc (Suc n))).
(λw. spick w n x) -` y ∩ space (fct_gen_subalgebra M borel (geom_proc n))
∈ sets (fct_gen_subalgebra M borel (geom_proc n))"
proof
fix A
assume A: "A ∈ sets (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
show "(λw. spick w n x) -` A ∩ space (fct_gen_subalgebra M borel (geom_proc n)) ∈
sets (fct_gen_subalgebra M borel (geom_proc n))"
proof -
define sp where "sp = (λw. spick w n x)"
have "A ∈ {(geom_proc (Suc n)) -` B ∩ space M |B. B ∈ sets borel}" using A
by (simp add:fct_gen_subalgebra_sigma_sets)
from this obtain C where "C∈ sets borel" and "A = (geom_proc (Suc n)) -`C ∩ space M" by auto
hence "A = (geom_proc (Suc n)) -`C" using bernoulli bernoulli_stream_space by simp
hence "sp -`A = sp -` (geom_proc (Suc n)) -`C" by simp
also have "... = (geom_proc (Suc n) ∘ sp) -` C" by auto
also have "... = (λw. (if x then u else d) * geom_proc n w) -` C" using geom_proc_spick
sp_def by auto
also have "... ∈ sets (fct_gen_subalgebra M borel (geom_proc n))"
proof (cases x)
case True
hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. u * geom_proc n w) -` C" by simp
moreover have "(λw. u * geom_proc n w) ∈ borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
proof -
have "geom_proc n ∈borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
using fct_gen_subalgebra_fct_measurable
by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
thus ?thesis by simp
qed
ultimately show ?thesis using ‹C∈ sets borel›
by (metis bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space measurable_sets)
next
case False
hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. d * geom_proc n w) -` C" by simp
moreover have "(λw. d * geom_proc n w) ∈ borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
proof -
have "geom_proc n ∈borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
using fct_gen_subalgebra_fct_measurable
by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
thus ?thesis by simp
qed
ultimately show ?thesis using ‹C∈ sets borel›
by (metis bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space measurable_sets)
qed
finally show ?thesis unfolding sp_def by (simp add: bernoulli bernoulli_stream_space fct_gen_subalgebra_space)
qed
qed
qed
lemma (in CRR_market) geom_spick_Suc:
assumes "A ∈ {(geom_proc (Suc n)) -` B |B. B ∈ sets borel}"
shows "(λw. spick w n x) -`A ∈ {geom_proc n -`B | B. B∈ sets borel}"
proof -
have "sets (fct_gen_subalgebra M borel (geom_proc n)) = {geom_proc n -` B ∩space M |B. B ∈ sets borel}"
by (simp add: fct_gen_subalgebra_sigma_sets)
also have "... = {geom_proc n -` B |B. B ∈ sets borel}" using bernoulli bernoulli_stream_space by simp
finally have sf: "sets (fct_gen_subalgebra M borel (geom_proc n)) = {geom_proc n -` B |B. B ∈ sets borel}" .
define sp where "sp = (λw. spick w n x)"
from assms(1) obtain C where "C∈ sets borel" and "A = (geom_proc (Suc n)) -`C" by auto
hence "A = (geom_proc (Suc n)) -`C" using bernoulli bernoulli_stream_space by simp
hence "sp -`A = sp -` (geom_proc (Suc n)) -`C" by simp
also have "... = (geom_proc (Suc n) ∘ sp) -` C" by auto
also have "... = (λw. (if x then u else d) * geom_proc n w) -` C" using geom_proc_spick
sp_def by auto
also have "... ∈ {geom_proc n -`B | B. B∈ sets borel}"
proof (cases x)
case True
hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. u * geom_proc n w) -` C" by simp
moreover have "(λw. u * geom_proc n w) ∈ borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
proof -
have "geom_proc n ∈borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
using fct_gen_subalgebra_fct_measurable
by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
thus ?thesis by simp
qed
ultimately show ?thesis using ‹C∈ sets borel› sf
by (simp add: bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space in_borel_measurable_borel)
next
case False
hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. d * geom_proc n w) -` C" by simp
moreover have "(λw. d * geom_proc n w) ∈ borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
proof -
have "geom_proc n ∈borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
using fct_gen_subalgebra_fct_measurable
by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
thus ?thesis by simp
qed
ultimately show ?thesis using ‹C∈ sets borel› sf
by (simp add: bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space in_borel_measurable_borel)
qed
finally show ?thesis unfolding sp_def .
qed
lemma (in CRR_market) geom_spick_lt:
assumes "m< n"
shows "geom_proc m (spick w n x) = geom_proc m w"
proof -
have "geom_proc m (spick w n x) = geom_proc m (pseudo_proj_True m (spick w n x))"
using geom_rand_walk_pseudo_proj_True by (metis comp_apply)
also have "... = geom_proc m (pseudo_proj_True m w)" using assms
by (metis less_imp_le_nat pseudo_proj_True_def pseudo_proj_True_prefix spickI)
also have "... = geom_proc m w" using geom_rand_walk_pseudo_proj_True by (metis comp_apply)
finally show ?thesis .
qed
lemma (in CRR_market) geom_spick_eq:
shows "geom_proc m (spick w m x) = geom_proc m w"
proof (cases x)
case True
have "geom_proc m (spick w m x) = geom_proc m (pseudo_proj_True m (spick w m x))"
using geom_rand_walk_pseudo_proj_True by (metis comp_apply)
also have "... = geom_proc m (pseudo_proj_True m w)" using True
by (metis pseudo_proj_True_def spickI)
also have "... = geom_proc m w" using geom_rand_walk_pseudo_proj_True by (metis comp_apply)
finally show ?thesis .
next
case False
have "geom_proc m (spick w m x) = geom_proc m (pseudo_proj_False m (spick w m x))"
using geom_rand_walk_pseudo_proj_False by (metis comp_apply)
also have "... = geom_proc m (pseudo_proj_False m w)" using False
by (metis pseudo_proj_False_def spickI)
also have "... = geom_proc m w" using geom_rand_walk_pseudo_proj_False by (metis comp_apply)
finally show ?thesis .
qed
lemma (in CRR_market) spick_red_geom_filt:
shows "(λw. spick w n x) ∈ measurable (G n) (G (Suc n))" unfolding measurable_def
proof (intro CollectI conjI)
show "(λw. spick w n x) ∈ space (G n) → space (G (Suc n))" using stock_filtration
by (simp add: bernoulli bernoulli_stream_space stoch_proc_filt_space)
show "∀y∈sets (G (Suc n)). (λw. spick w n x) -` y ∩ space (G n) ∈ sets (G n)"
proof
fix B
assume "B∈ sets (G (Suc n))"
hence "B∈ (sigma_sets (space M) (⋃ i∈ {m. m≤ (Suc n)}. {(geom_proc i -`A) ∩ (space M) | A. A∈ sets borel }))"
using stock_filtration stoch_proc_filt_sets geometric_process
proof -
have "∀n. sigma_sets (space M) (⋃n∈{na. na ≤ n}. {geom_proc n -` R ∩ space M |R. R ∈ sets borel}) = sets (G n)"
by (simp add: geom_rand_walk_borel_measurable stoch_proc_filt_sets stock_filtration)
then show ?thesis
using ‹B ∈ sets (G (Suc n))› by blast
qed
hence "(λw. spick w n x) -` B ∈ sets (G n)"
proof (induct rule:sigma_sets.induct)
{
fix C
assume "C ∈ (⋃i∈{m. m ≤ Suc n}. {geom_proc i -` A ∩ space M |A. A ∈ sets borel})"
hence "∃m ≤ Suc n. C∈ {geom_proc m -` A ∩ space M |A. A ∈ sets borel}" by auto
from this obtain m where "m≤ Suc n" and "C∈ {geom_proc m -` A ∩ space M |A. A ∈ sets borel}" by auto
note Cprops = this
from this obtain D where "C = geom_proc m -` D∩ space M" and "D∈ sets borel" by auto
hence "C = geom_proc m -`D" using bernoulli bernoulli_stream_space by simp
have "C∈ {geom_proc m -` A |A. A ∈ sets borel}" using bernoulli bernoulli_stream_space Cprops by simp
show "(λw. spick w n x) -` C ∈ sets (G n)"
proof (cases "m ≤ n")
case True
have "(λw. spick w n x) -` C = (λw. spick w n x) -` geom_proc m -`D" using ‹C = geom_proc m -`D› by simp
also have "... = (geom_proc m ∘ (λw. spick w n x)) -`D" by auto
also have "... = geom_proc m -`D" using geom_spick_lt geom_spick_eq ‹m≤n›
using le_eq_less_or_eq by auto
also have "... ∈ sets (G n)" using stock_filtration geometric_process
‹D∈ sets borel›
by (metis (no_types, lifting) True adapt_stoch_proc_def bernoulli bernoulli_stream_preimage
geom_rand_walk_borel_measurable increasing_measurable_info measurable_sets stoch_proc_filt_adapt
stoch_proc_filt_space)
finally show "(λw. spick w n x) -` C ∈ sets (G n)" .
next
case False
hence "m = Suc n" using ‹m ≤ Suc n› by simp
hence "(λw. spick w n x) -` C ∈ {geom_proc n -` B |B. B ∈ sets borel}"
using ‹C∈ {geom_proc m -` A |A. A ∈ sets borel}› geom_spick_Suc by simp
also have "... ⊆ sets (G n)"
proof -
have "{geom_proc n -` B |B. B ∈ sets borel} ⊆ {geom_proc n -` B ∩ space M |B. B ∈ sets borel}"
using bernoulli bernoulli_stream_space by simp
also have "... ⊆ (⋃i∈{m. m ≤ n}. {geom_proc i -` A ∩ space M |A. A ∈ sets borel})"
by auto
also have "... ⊆ sigma_sets (space M) (⋃i∈{m. m ≤ n}. {geom_proc i -` A ∩ space M |A. A ∈ sets borel})"
by (rule sigma_sets_superset_generator)
also have "... = sets (G n)" using stock_filtration geometric_process
stoch_proc_filt_sets[of n geom_proc M borel] geom_rand_walk_borel_measurable by blast
finally show ?thesis .
qed
finally show ?thesis .
qed
}
show "(λw. spick w n x) -` {} ∈ sets (G n)" by simp
{
fix C
assume "C ∈ sigma_sets (space M) (⋃i∈{m. m ≤ Suc n}. {geom_proc i -` A ∩ space M |A. A ∈ sets borel})"
and "(λw. spick w n x) -` C ∈ sets (G n)"
hence "(λw. spick w n x) -` (space M - C) = (λw. spick w n x) -` (space M) - (λw. spick w n x) -` C"
by (simp add: vimage_Diff)
also have "... = space M - (λw. spick w n x) -` C" using bernoulli bernoulli_stream_space by simp
also have "... ∈ sets (G n)" using ‹(λw. spick w n x) -` C ∈ sets (G n)›
by (metis algebra.compl_sets disc_filtr_def discrete_filtration sets.sigma_algebra_axioms
sigma_algebra_def subalgebra_def)
finally show "(λw. spick w n x) -` (space M - C) ∈ sets (G n)" .
}
{
fix C::"nat ⇒ bool stream set"
assume "(⋀i. C i ∈ sigma_sets (space M) (⋃i∈{m. m ≤ Suc n}. {geom_proc i -` A ∩ space M |A. A ∈ sets borel}))"
and "(⋀i. (λw. spick w n x) -` C i ∈ sets (G n))"
hence "(λw. spick w n x) -` ⋃(C ` UNIV) = (⋃ i∈ UNIV. (λw. spick w n x) -` (C i))" by blast
also have "... ∈ sets (G n)" using ‹⋀i. (λw. spick w n x) -` C i ∈ sets (G n)› by simp
finally show "(λw. spick w n x) -` ⋃(C ` UNIV) ∈ sets (G n)" .
}
qed
thus "(λw. spick w n x) -` B ∩ space (G n) ∈ sets (G n)" using stock_filtration stoch_proc_filt_space
bernoulli bernoulli_stream_space by simp
qed
qed
lemma (in CRR_market) delta_price_adapted:
fixes cash_flow::"bool stream ⇒ real"
assumes "cash_flow ∈ borel_measurable (G T)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "borel_adapt_stoch_proc G (delta_price N cash_flow T)"
unfolding adapt_stoch_proc_def
proof
fix n
show "delta_price N cash_flow T n ∈ borel_measurable (G n)"
proof (cases "Suc n ≤ T")
case True
hence deleq: "∀w. delta_price N cash_flow T n w = (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
((geom_proc n w) * (u - d))" using delta_price_eq by simp
have "(λw. rn_price N cash_flow T (Suc n) (spick w n True)) ∈ borel_measurable (G n)"
proof -
have "rn_price N cash_flow T (Suc n) ∈ borel_measurable (G (Suc n))" using rn_price_borel_adapt assms
using True by blast
moreover have "(λw. spick w n True) ∈ G n →⇩M G (Suc n)" using spick_red_geom_filt by simp
ultimately show ?thesis by simp
qed
moreover have "(λw. rn_price N cash_flow T (Suc n) (spick w n False)) ∈ borel_measurable (G n)"
proof -
have "rn_price N cash_flow T (Suc n) ∈ borel_measurable (G (Suc n))" using rn_price_borel_adapt assms
using True by blast
moreover have "(λw. spick w n False) ∈ G n →⇩M G (Suc n)" using spick_red_geom_filt by simp
ultimately show ?thesis by simp
qed
ultimately have "(λw. rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))
∈ borel_measurable (G n)" by simp
moreover have "(λw. (geom_proc n w) * (u - d)) ∈ borel_measurable (G n)"
proof -
have "geom_proc n ∈ borel_measurable (G n)" using stock_filtration
by (metis adapt_stoch_proc_def stk_price stock_price_borel_measurable)
thus ?thesis by simp
qed
ultimately have "(λw. (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
((geom_proc n w) * (u - d)))∈ borel_measurable (G n)" by simp
thus ?thesis using deleq by presburger
next
case False
thus ?thesis unfolding delta_price_def by simp
qed
qed
fun (in CRR_market) delta_predict where
"delta_predict N der matur 0 = (λw. delta_price N der matur 0 w)" |
"delta_predict N der matur (Suc n) = (λw. delta_price N der matur n w)"
lemma (in CRR_market) delta_predict_predict:
assumes "der ∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "borel_predict_stoch_proc G (delta_predict N der matur)" unfolding predict_stoch_proc_def
proof (intro conjI)
show "delta_predict N der matur 0 ∈ borel_measurable (G 0)" using delta_price_adapted[of der matur N q]
assms unfolding adapt_stoch_proc_def by force
show "∀n. delta_predict N der matur (Suc n) ∈ borel_measurable (G n)"
proof
fix n
show "delta_predict N der matur (Suc n) ∈ borel_measurable (G n)" using delta_price_adapted[of der matur N q]
assms unfolding adapt_stoch_proc_def by force
qed
qed
definition (in CRR_market) delta_pf where
"delta_pf N der matur = qty_single stk (delta_predict N der matur)"
lemma (in CRR_market) delta_pf_support:
shows "support_set (delta_pf N der matur) ⊆ {stk}" unfolding delta_pf_def
using single_comp_support[of stk "delta_predict N der matur"] by simp
definition (in CRR_market) self_fin_delta_pf where
"self_fin_delta_pf N der matur v0 = self_finance Mkt v0 (delta_pf N der matur) risk_free_asset"
lemma (in disc_equity_market) self_finance_trading_strat:
assumes "trading_strategy pf"
and "portfolio pf"
and "borel_adapt_stoch_proc F (prices Mkt asset)"
and "support_adapt Mkt pf"
shows "trading_strategy (self_finance Mkt v pf asset)" unfolding self_finance_def
proof (rule sum_trading_strat)
show "trading_strategy pf" using assms by simp
show "trading_strategy (qty_single asset (remaining_qty Mkt v pf asset))" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio (qty_single asset (remaining_qty Mkt v pf asset))"
by (simp add: self_finance_def single_comp_portfolio)
show "⋀a.
a ∈ support_set (qty_single asset (remaining_qty Mkt v pf asset)) ⟹
borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)"
proof (cases "support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {}")
case False
hence eqasset: "support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {asset}"
using single_comp_support by fastforce
fix a
assume "a∈ support_set (qty_single asset (remaining_qty Mkt v pf asset))"
hence "a = asset" using eqasset by simp
hence "qty_single asset (remaining_qty Mkt v pf asset) a = (remaining_qty Mkt v pf asset)"
unfolding qty_single_def by simp
moreover have "borel_predict_stoch_proc F (remaining_qty Mkt v pf asset)"
proof (rule remaining_qty_predict)
show "trading_strategy pf" using assms by simp
show "borel_adapt_stoch_proc F (prices Mkt asset)" using assms by simp
show "support_adapt Mkt pf" using assms by simp
qed
ultimately show "borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)"
by simp
next
case True
thus "⋀a. a ∈ support_set (qty_single asset (remaining_qty Mkt v pf asset)) ⟹
support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {} ⟹
borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)" by simp
qed
qed
qed
lemma (in CRR_market) self_fin_delta_pf_trad_strat:
assumes "der∈ borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "trading_strategy (self_fin_delta_pf N der matur v0)" unfolding self_fin_delta_pf_def
proof (rule self_finance_trading_strat)
show "trading_strategy (delta_pf N der matur)" unfolding trading_strategy_def
proof (intro conjI ballI)
show "portfolio (delta_pf N der matur)" unfolding portfolio_def using delta_pf_support
by (meson finite.emptyI finite_insert infinite_super)
show "⋀asset. asset ∈ support_set (delta_pf N der matur) ⟹ borel_predict_stoch_proc G (delta_pf N der matur asset)"
proof (cases "support_set (delta_pf N der matur) = {}")
case False
fix asset
assume "asset ∈ support_set (delta_pf N der matur)"
hence "asset = stk" using False delta_pf_support by auto
hence "delta_pf N der matur asset = delta_predict N der matur" unfolding delta_pf_def qty_single_def by simp
thus "borel_predict_stoch_proc G (delta_pf N der matur asset)" using delta_predict_predict
assms by simp
next
case True
thus "⋀asset. asset ∈ support_set (delta_pf N der matur) ⟹
support_set (delta_pf N der matur) = {} ⟹ borel_predict_stoch_proc G (delta_pf N der matur asset)" by simp
qed
qed
show "portfolio (delta_pf N der matur)" using delta_pf_support unfolding portfolio_def
by (meson finite.emptyI finite_insert infinite_super)
show "borel_adapt_stoch_proc G (prices Mkt risk_free_asset)" using rf_price
disc_rfr_proc_borel_adapted by simp
show "support_adapt Mkt (delta_pf N der matur)" unfolding support_adapt_def
proof
show "⋀asset. asset ∈ support_set (delta_pf N der matur) ⟹ borel_adapt_stoch_proc G (prices Mkt asset)"
proof (cases "support_set (delta_pf N der matur) = {}")
case False
fix asset
assume "asset ∈ support_set (delta_pf N der matur)"
hence "asset = stk" using False delta_pf_support by auto
hence "prices Mkt asset = geom_proc" using stk_price by simp
thus "borel_adapt_stoch_proc G (prices Mkt asset)"
using ‹asset = stk› stock_price_borel_measurable by auto
next
case True
thus "⋀asset. asset ∈ support_set (delta_pf N der matur) ⟹ borel_adapt_stoch_proc G (prices Mkt asset)"
by simp
qed
qed
qed
definition (in CRR_market) delta_hedging where
"delta_hedging N der matur = self_fin_delta_pf N der matur
(prob_space.expectation N (discounted_value r (λm. der) matur))"
lemma (in CRR_market) geom_proc_eq_snth:
shows "(⋀m. m ≤ Suc n ⟹ geom_proc m x = geom_proc m y) ⟹
(⋀m. m ≤ n ⟹ snth x m = snth y m)"
proof (induct n )
case 0
assume asm: "(⋀m. m ≤Suc 0 ⟹ geom_proc m x = geom_proc m y)" and "m≤ 0"
hence "m = 0" by simp
have "geom_proc (Suc 0) x = geom_proc (Suc 0) y" using asm by simp
have "snth x 0 = snth y 0"
proof (rule ccontr)
assume "snth x 0 ≠ snth y 0"
show False
proof (cases "snth x 0")
case True
hence "¬ snth y 0" using ‹snth x 0 ≠ snth y 0› by simp
have "geom_proc (Suc 0) x = u * init" using geometric_process True by simp
moreover have "geom_proc (Suc 0) y = d * init" using geometric_process ‹¬ snth y 0› by simp
ultimately have "geom_proc (Suc 0) x ≠ geom_proc (Suc 0) y" using S0_positive down_lt_up by simp
thus ?thesis using ‹geom_proc (Suc 0) x = geom_proc (Suc 0) y› by simp
next
case False
hence "snth y 0" using ‹snth x 0 ≠ snth y 0› by simp
have "geom_proc (Suc 0) x = d * init" using geometric_process False by simp
moreover have "geom_proc (Suc 0) y = u * init" using geometric_process ‹snth y 0› by simp
ultimately have "geom_proc (Suc 0) x ≠ geom_proc (Suc 0) y" using S0_positive down_lt_up by simp
thus ?thesis using ‹geom_proc (Suc 0) x = geom_proc (Suc 0) y› by simp
qed
qed
thus "⋀m. (⋀m. m ≤ Suc 0 ⟹ geom_proc m x = geom_proc m y) ⟹ m ≤ 0 ⟹ x !! m = y !! m" by simp
next
case (Suc n)
assume fst: "(⋀m. (⋀m. m ≤ Suc n ⟹ geom_proc m x = geom_proc m y) ⟹ m ≤ n ⟹ x !! m = y !! m)"
and scd: "(⋀m. m ≤ Suc (Suc n) ⟹ geom_proc m x = geom_proc m y)" and "m ≤ Suc n"
show "x !! m = y !! m"
proof (cases "m ≤ n")
case True
thus ?thesis using fst scd by simp
next
case False
hence "m = Suc n" using ‹m≤ Suc n› by simp
have "geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y" using scd by simp
show ?thesis
proof (rule ccontr)
assume "x !! m ≠ y !! m"
thus False
proof (cases "x !! m")
case True
hence "¬ y !! m" using ‹x !! m ≠ y !! m› by simp
have "geom_proc (Suc (Suc n)) x = u * geom_proc (Suc n) x" using geometric_process True
‹m = Suc n› by simp
also have "... = u * geom_proc (Suc n) y" using scd ‹m = Suc n› by simp
finally have "geom_proc (Suc (Suc n)) x = u * geom_proc (Suc n) y" .
moreover have "geom_proc (Suc (Suc n)) y = d * geom_proc (Suc n) y" using geometric_process
‹m = Suc n› ‹¬ y !! m› by simp
ultimately have "geom_proc (Suc (Suc n)) x ≠ geom_proc (Suc (Suc n)) y"
by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl mult_cancel_right)
thus ?thesis using ‹geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y› by simp
next
case False
hence "y !! m" using ‹x !! m ≠ y !! m› by simp
have "geom_proc (Suc (Suc n)) x = d * geom_proc (Suc n) x" using geometric_process False
‹m = Suc n› by simp
also have "... = d * geom_proc (Suc n) y" using scd ‹m = Suc n› by simp
finally have "geom_proc (Suc (Suc n)) x = d * geom_proc (Suc n) y" .
moreover have "geom_proc (Suc (Suc n)) y = u * geom_proc (Suc n) y" using geometric_process
‹m = Suc n› ‹y !! m› by simp
ultimately have "geom_proc (Suc (Suc n)) x ≠ geom_proc (Suc (Suc n)) y"
by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl mult_cancel_right)
thus ?thesis using ‹geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y› by simp
qed
qed
qed
qed
lemma (in CRR_market) geom_proc_eq_pseudo_proj_True:
shows "(⋀m. m ≤ n ⟹ geom_proc m x = geom_proc m y) ⟹
(pseudo_proj_True (n) x = pseudo_proj_True (n) y)"
proof -
assume a1: "⋀m. m ≤ n ⟹ geom_proc m x = geom_proc m y"
obtain nn :: "bool stream ⇒ bool stream ⇒ nat ⇒ nat" where
"∀x1 x2 x3. (∃v4<Suc (Suc x3). geom_proc v4 x2 ≠ geom_proc v4 x1) = (nn x1 x2 x3 < Suc (Suc x3) ∧ geom_proc (nn x1 x2 x3) x2 ≠ geom_proc (nn x1 x2 x3) x1)"
by moura
then have f2: "∀n s sa na. (nn sa s n < Suc (Suc n) ∧ geom_proc (nn sa s n) s ≠ geom_proc (nn sa s n) sa ∨ ¬ na < Suc n) ∨ s !! na = sa !! na"
by (meson geom_proc_eq_snth less_Suc_eq_le)
obtain nna :: "bool stream ⇒ bool stream ⇒ nat ⇒ nat" where
f3: "∀x0 x1 x2. (∃v3. Suc v3 < Suc x2 ∧ x1 !! v3 ≠ x0 !! v3) = (Suc (nna x0 x1 x2) < Suc x2 ∧ x1 !! nna x0 x1 x2 ≠ x0 !! nna x0 x1 x2)"
by moura
obtain nnb :: "nat ⇒ nat" where
f4: "∀x0. (∃v2. x0 = Suc v2) = (x0 = Suc (nnb x0))"
by moura
moreover
{ assume "¬ nn y x (nnb n) < Suc (Suc (nnb n)) ∨ geom_proc (nn y x (nnb n)) x = geom_proc (nn y x (nnb n)) y"
moreover
{ assume "¬ nna y x n < Suc (nnb n)"
then have "¬ Suc (nna y x n) < Suc n ∨ x !! nna y x n = y !! nna y x n"
using f4 by (metis (no_types) Suc_le_D Suc_le_lessD less_Suc_eq_le) }
ultimately have "pseudo_proj_True n x = pseudo_proj_True n y ∨ ¬ Suc (nna y x n) < Suc n ∨ x !! nna y x n = y !! nna y x n"
using f2 by meson }
ultimately have "pseudo_proj_True n x = pseudo_proj_True n y ∨ ¬ Suc (nna y x n) < Suc n ∨ x !! nna y x n = y !! nna y x n"
using a1 Suc_le_D less_Suc_eq_le by presburger
then show ?thesis
using f3 by (meson less_Suc_eq_le pseudo_proj_True_snth')
qed
lemma (in CRR_market) proj_stoch_eq_pseudo_proj_True:
assumes "proj_stoch_proc geom_proc m x = proj_stoch_proc geom_proc m y"
shows "pseudo_proj_True m x = pseudo_proj_True m y"
proof -
have "∀ k ≤ m. geom_proc k x = geom_proc k y"
proof (intro allI impI)
fix k
assume "k ≤ m"
thus "geom_proc k x = geom_proc k y" using proj_stoch_proc_eq_snth[of geom_proc m x y k] assms by simp
qed
thus ?thesis using geom_proc_eq_pseudo_proj_True[of m x y] by auto
qed
lemma (in CRR_market_viable) rn_rev_price_cond_expect:
assumes "N = bernoulli_stream q"
and "0 <q"
and "q < 1"
and "der ∈ borel_measurable (G matur)"
and "Suc n ≤ matur"
shows "expl_cond_expect N (proj_stoch_proc geom_proc n) (rn_rev_price N der matur (matur - Suc n)) w=
(q * rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True n w) +
(1 - q) * rn_rev_price N der matur (matur - Suc n) (pseudo_proj_False n w))"
proof (rule infinite_cts_filtration.f_borel_Suc_expl_cond_expect)
show "infinite_cts_filtration q N nat_filtration" using assms pslt psgt
bernoulli_nat_filtration by simp
show "rn_rev_price N der matur (matur - Suc n) ∈ borel_measurable (nat_filtration (Suc n))"
using rn_rev_price_rev_borel_adapt[of der matur N q "Suc n"] assms
stock_filtration stoch_proc_subalg_nat_filt[of geom_proc] geom_rand_walk_borel_adapted
by (metis add_diff_cancel_right' diff_le_self measurable_from_subalg
ordered_cancel_comm_monoid_diff_class.add_diff_inverse rn_rev_price_rev_borel_adapt)
show "proj_stoch_proc geom_proc n ∈ nat_filtration n →⇩M stream_space borel"
using proj_stoch_adapted_if_adapted[of M nat_filtration geom_proc borel n]
pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted
nat_discrete_filtration by blast
show "set_discriminating n (proj_stoch_proc geom_proc n) (stream_space borel)"
using infinite_cts_filtration.proj_stoch_set_discriminating
pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted by simp
show "proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w} ∈ sets (nat_filtration n)"
using infinite_cts_filtration.proj_stoch_singleton_set
pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted by simp
show "∀y z. proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n ⟶
rn_rev_price N der matur (matur - Suc n) y = rn_rev_price N der matur (matur - Suc n) z"
proof (intro allI impI)
fix y z
assume as:"proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z ∧ y !! n = z !! n"
hence "pseudo_proj_True n y = pseudo_proj_True n z" using proj_stoch_eq_pseudo_proj_True[of n y z] by simp
moreover have "snth y n = snth z n" using as by simp
ultimately have "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z"
proof -
have f1: "∀n s sa. (∃na. Suc na ≤ n ∧ s !! na ≠ sa !! na) ∨ pseudo_proj_True n s = pseudo_proj_True n sa"
by (meson pseudo_proj_True_snth')
obtain nn :: "bool stream ⇒ bool stream ⇒ nat ⇒ nat" where
"∀x0 x1 x2. (∃v3. Suc v3 ≤ x2 ∧ x1 !! v3 ≠ x0 !! v3) = (Suc (nn x0 x1 x2) ≤ x2 ∧ x1 !! nn x0 x1 x2 ≠ x0 !! nn x0 x1 x2)"
by moura
then have f2: "∀n s sa. Suc (nn sa s n) ≤ n ∧ s !! nn sa s n ≠ sa !! nn sa s n ∨ pseudo_proj_True n s = pseudo_proj_True n sa"
using f1 by presburger
have f3: "stake n y = stake n (pseudo_proj_True n z)"
by (metis ‹pseudo_proj_True n y = pseudo_proj_True n z› pseudo_proj_True_stake)
{ assume "stake (Suc n) z ≠ stake (Suc n) (pseudo_proj_True (Suc n) y)"
then have "stake n y @ [y !! n] ≠ stake n z @ [z !! n]"
by (metis (no_types) pseudo_proj_True_stake stake_Suc)
then have "stake (Suc n) z = stake (Suc n) (pseudo_proj_True (Suc n) y)"
using f3 by (simp add: ‹y !! n = z !! n› pseudo_proj_True_stake) }
then have "¬ Suc (nn z y (Suc n)) ≤ Suc n ∨ y !! nn z y (Suc n) = z !! nn z y (Suc n)"
by (metis (no_types) pseudo_proj_True_stake stake_snth)
then show ?thesis
using f2 by blast
qed
have "rn_rev_price N der matur (matur - Suc n) y =
rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True (Suc n) y)" using nat_filtration_info[of "rn_rev_price N der matur (matur - Suc n)" "Suc n"]
rn_rev_price_rev_borel_adapt[of der matur N q]
by (metis ‹rn_rev_price N der matur (matur - Suc n) ∈ borel_measurable (nat_filtration (Suc n))› o_apply)
also have "... = rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True (Suc n) z)"
using ‹pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z› by simp
also have "... = rn_rev_price N der matur (matur - Suc n) z" using nat_filtration_info[of "rn_rev_price N der matur (matur - Suc n)" "Suc n"]
rn_rev_price_rev_borel_adapt[of der matur N q]
by (metis ‹rn_rev_price N der matur (matur - Suc n) ∈ borel_measurable (nat_filtration (Suc n))› o_apply)
finally show "rn_rev_price N der matur (matur - Suc n) y = rn_rev_price N der matur (matur - Suc n) z" .
qed
show "0 < q" and "q < 1" using assms by auto
qed
lemma (in CRR_market_viable) rn_price_eq_ind:
assumes "N = bernoulli_stream q"
and "n < matur"
and "0 < q"
and "q < 1"
and "der ∈ borel_measurable (G matur)"
shows "(1+r) * rn_price N der matur n w = q * rn_price N der matur (Suc n) (pseudo_proj_True n w) +
(1 - q) * rn_price N der matur (Suc n) (pseudo_proj_False n w)"
proof -
define V where "V = rn_price N der matur"
let ?m = "matur - Suc n"
have "matur -n = Suc ?m" by (simp add: assms Suc_diff_Suc Suc_le_lessD)
have "(1+r) * V n w = (1+r) * rn_price_ind N der matur n w" using rn_price_eq assms unfolding V_def by simp
also have "... = (1+r) * rn_rev_price N der matur (Suc ?m) w" using ‹matur -n = Suc ?m›
unfolding rn_price_ind_def by simp
also have "... = (1+r) * discount_factor r (Suc 0) w *
expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc ?m)) (rn_rev_price N der matur ?m) w"
by simp
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc ?m)) (rn_rev_price N der matur ?m) w"
unfolding discount_factor_def using acceptable_rate by auto
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc n) (rn_rev_price N der matur ?m) w"
using ‹matur -n = Suc ?m› by simp
also have "... = (q * rn_rev_price N der matur ?m (pseudo_proj_True n w) +
(1 - q) * rn_rev_price N der matur ?m (pseudo_proj_False n w))"
using rn_rev_price_cond_expect[of N q der matur n w] assms by simp
also have "... = q * rn_price_ind N der matur (Suc n) (pseudo_proj_True n w) +
(1 - q) * rn_price_ind N der matur (Suc n) (pseudo_proj_False n w)" unfolding rn_price_ind_def by simp
also have "... = q * rn_price N der matur (Suc n) (pseudo_proj_True n w) +
(1 - q) * rn_price N der matur (Suc n) (pseudo_proj_False n w)" using rn_price_eq assms by simp
also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)"
unfolding V_def by simp
finally have "(1+r) * V n w = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)" .
thus ?thesis unfolding V_def by simp
qed
lemma self_finance_updated_suc_suc:
assumes "portfolio pf"
and "∀n. prices Mkt asset n w ≠ 0"
shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc n)) w = cls_val_process Mkt pf (Suc (Suc n)) w +
(prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
(cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w -
val_process Mkt pf (Suc n) w)"
proof -
have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc n)) w = cls_val_process Mkt pf (Suc (Suc n)) w +
prices Mkt asset (Suc (Suc n)) w * remaining_qty Mkt v pf asset (Suc (Suc n)) w" using assms
by (simp add: self_finance_updated)
also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
prices Mkt asset (Suc (Suc n)) w * ((remaining_qty Mkt v pf asset (Suc n) w) +
(cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
by simp
also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
prices Mkt asset (Suc (Suc n)) w *
((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) / (prices Mkt asset (Suc n) w) +
(cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))" using assms
by (metis nonzero_mult_div_cancel_left)
also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
prices Mkt asset (Suc (Suc n)) w * ((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) +
cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w)"
using add_divide_distrib[symmetric, of "prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w"
"prices Mkt asset (Suc n) w"] by simp
also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
(prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) +
cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)" by simp
also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
(prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
(cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w -
val_process Mkt pf (Suc n) w)"
using self_finance_updated[of Mkt asset n w pf v] assms by auto
finally show ?thesis .
qed
lemma self_finance_updated_suc_0:
assumes "portfolio pf"
and "∀n w. prices Mkt asset n w ≠ 0"
shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc 0) w = cls_val_process Mkt pf (Suc 0) w +
(prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
(val_process Mkt (self_finance Mkt v pf asset) 0 w -
val_process Mkt pf 0 w)"
proof -
have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc 0) w = cls_val_process Mkt pf (Suc 0) w +
prices Mkt asset (Suc 0) w * remaining_qty Mkt v pf asset (Suc 0) w" using assms
by (simp add: self_finance_updated)
also have "... = cls_val_process Mkt pf (Suc 0) w +
prices Mkt asset (Suc 0) w * ((v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))"
by simp
also have "... = cls_val_process Mkt pf (Suc 0) w +
prices Mkt asset (Suc 0) w * ((remaining_qty Mkt v pf asset 0 w) +
(v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))"
by simp
also have "... = cls_val_process Mkt pf (Suc 0) w +
prices Mkt asset (Suc 0) w *
((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) / (prices Mkt asset 0 w) +
(v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))" using assms
by (metis nonzero_mult_div_cancel_left)
also have "... = cls_val_process Mkt pf (Suc 0) w +
prices Mkt asset (Suc 0) w * ((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)"
using add_divide_distrib[symmetric, of "prices Mkt asset 0 w * remaining_qty Mkt v pf asset 0 w"
"prices Mkt asset 0 w"] by simp
also have "... = cls_val_process Mkt pf (Suc 0) w +
(prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
v - val_process Mkt pf 0 w)" by simp
also have "... = cls_val_process Mkt pf (Suc 0) w +
(prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
val_process Mkt (self_finance Mkt v pf asset) 0 w - val_process Mkt pf 0 w)"
using self_finance_init[of Mkt asset pf v w] assms by simp
also have "... = cls_val_process Mkt pf (Suc 0) w +
(prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
(val_process Mkt (self_finance Mkt v pf asset) 0 w -
val_process Mkt pf 0 w)" by simp
finally show ?thesis .
qed
lemma self_finance_updated_ind:
assumes "portfolio pf"
and "∀n w. prices Mkt asset n w ≠ 0"
shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w = cls_val_process Mkt pf (Suc n) w +
(prices Mkt asset (Suc n) w / (prices Mkt asset n w)) *
(val_process Mkt (self_finance Mkt v pf asset) n w -
val_process Mkt pf n w)"
proof (cases "n = 0")
case True
thus ?thesis using assms self_finance_updated_suc_0 by simp
next
case False
hence "∃m. n = Suc m" by (simp add: not0_implies_Suc)
from this obtain m where "n = Suc m" by auto
hence "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc m)) w" by simp
also have "... = cls_val_process Mkt pf (Suc (Suc m)) w +
(prices Mkt asset (Suc (Suc m)) w / (prices Mkt asset (Suc m) w)) *
(cls_val_process Mkt (self_finance Mkt v pf asset) (Suc m) w -
val_process Mkt pf (Suc m) w)" using assms self_finance_updated_suc_suc[of pf] by simp
also have "... = cls_val_process Mkt pf (Suc (Suc m)) w +
(prices Mkt asset (Suc (Suc m)) w / (prices Mkt asset (Suc m) w)) *
(val_process Mkt (self_finance Mkt v pf asset) (Suc m) w -
val_process Mkt pf (Suc m) w)" using assms self_finance_charact unfolding self_financing_def
by (simp add: self_finance_succ self_finance_updated)
also have "... = cls_val_process Mkt pf (Suc n) w +
(prices Mkt asset (Suc n) w / (prices Mkt asset n w)) *
(val_process Mkt (self_finance Mkt v pf asset) n w -
val_process Mkt pf n w)" using ‹n = Suc m› by simp
finally show ?thesis .
qed
lemma (in rfr_disc_equity_market) self_finance_risk_free_update_ind:
assumes "portfolio pf"
shows "cls_val_process Mkt (self_finance Mkt v pf risk_free_asset) (Suc n) w = cls_val_process Mkt pf (Suc n) w +
(1 + r) * (val_process Mkt (self_finance Mkt v pf risk_free_asset) n w - val_process Mkt pf n w)"
proof -
have "cls_val_process Mkt (self_finance Mkt v pf risk_free_asset) (Suc n) w =
cls_val_process Mkt pf (Suc n) w +
(prices Mkt risk_free_asset (Suc n) w / (prices Mkt risk_free_asset n w)) *
(val_process Mkt (self_finance Mkt v pf risk_free_asset) n w -
val_process Mkt pf n w)"
proof (rule self_finance_updated_ind, (simp add: assms), intro allI)
fix n w
show "prices Mkt risk_free_asset n w ≠ 0" using positive by (metis less_irrefl)
qed
also have "... = cls_val_process Mkt pf (Suc n) w +
(1+r) * (val_process Mkt (self_finance Mkt v pf risk_free_asset) n w -
val_process Mkt pf n w)" using rf_price positive
by (metis acceptable_rate disc_rfr_proc_Suc_div)
finally show ?thesis .
qed
lemma (in CRR_market) delta_pf_portfolio:
shows "portfolio (delta_pf N der matur)" unfolding delta_pf_def by (simp add: single_comp_portfolio)
lemma (in CRR_market) delta_pf_updated:
shows "cls_val_process Mkt (delta_pf N der matur) (Suc n) w =
geom_proc (Suc n) w * delta_price N der matur n w" unfolding delta_pf_def
using stk_price qty_single_updated[of Mkt] by simp
lemma (in CRR_market) delta_pf_val_process:
shows "val_process Mkt (delta_pf N der matur) n w =
geom_proc n w * delta_price N der matur n w" unfolding delta_pf_def
using stk_price qty_single_val_process[of Mkt] by simp
lemma (in CRR_market) delta_hedging_cls_val_process:
shows "cls_val_process Mkt (delta_hedging N der matur) (Suc n) w =
geom_proc (Suc n) w * delta_price N der matur n w +
(1 + r) * (val_process Mkt (delta_hedging N der matur) n w - geom_proc n w * delta_price N der matur n w)"
proof -
define X where "X = delta_hedging N der matur"
define init where "init = integral⇧L N (discounted_value r (λm. der) matur)"
have "cls_val_process Mkt X (Suc n) w = cls_val_process Mkt (delta_pf N der matur) (Suc n) w +
(1 + r) * (val_process Mkt X n w - val_process Mkt (delta_pf N der matur) n w)"
unfolding X_def delta_hedging_def self_fin_delta_pf_def init_def
proof (rule self_finance_risk_free_update_ind)
show "portfolio (delta_pf N der matur)" unfolding portfolio_def using delta_pf_support
by (meson finite.simps infinite_super)
qed
also have "... = geom_proc (Suc n) w * delta_price N der matur n w +
(1 + r) * (val_process Mkt X n w - val_process Mkt (delta_pf N der matur) n w)"
using delta_pf_updated by simp
also have "... = geom_proc (Suc n) w * delta_price N der matur n w +
(1 + r) * (val_process Mkt X n w - geom_proc n w * delta_price N der matur n w)"
using delta_pf_val_process by simp
finally show ?thesis unfolding X_def .
qed
lemma (in CRR_market_viable) delta_hedging_eq_derivative_price:
fixes der::"bool stream ⇒ real" and matur::nat
assumes "N = bernoulli_stream ((1 + r - d) / (u - d))"
and "der∈ borel_measurable (G matur)"
shows "⋀n w. n≤ matur ⟹
val_process Mkt (delta_hedging N der matur) n w =
(rn_price N der matur) n w"
unfolding delta_hedging_def
proof -
define q where "q = (1 + r - d) / (u - d)"
have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
note qprops = this
define init where "init = (prob_space.expectation N (discounted_value r (λm. der) matur))"
define X where "X = val_process Mkt (delta_hedging N der matur)"
define V where "V = rn_price N der matur"
define Δ where "Δ = delta_price N der matur"
{
fix n
fix w
have "n ≤ matur ⟹ X n w = V n w"
proof (induct n)
case 0
have v0: "V 0 ∈ borel_measurable (G 0)" using assms rn_price_borel_adapt "0.prems" qprops
unfolding V_def q_def by auto
have "X 0 w= init" using self_finance_init[of Mkt risk_free_asset "delta_pf N der matur" "integral⇧L N (discounted_value r (λm. der) matur)"]
delta_pf_support
unfolding X_def init_def delta_hedging_def self_fin_delta_pf_def init_def
by (metis finite_insert infinite_imp_nonempty infinite_super less_irrefl portfolio_def positive)
also have "... = V 0 w"
proof -
have "∀x∈space N. real_cond_exp N (G 0) (discounted_value r (λm. der) matur) x =
integral⇧L N (discounted_value r (λm. der) matur)"
proof (rule prob_space.trivial_subalg_cond_expect_eq)
show "prob_space N" using assms qprops unfolding q_def
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
have "init_triv_filt M (stoch_proc_filt M geom_proc borel)"
proof (rule infinite_cts_filtration.stoch_proc_filt_triv_init)
show "borel_adapt_stoch_proc nat_filtration geom_proc" using geom_rand_walk_borel_adapted by simp
show "infinite_cts_filtration p M nat_filtration" using bernoulli_nat_filtration[of M p] bernoulli psgt pslt
by simp
qed
hence "init_triv_filt N (stoch_proc_filt M geom_proc borel)" using assms qprops
filt_equiv_triv_init[of nat_filtration N] stock_filtration
bernoulli_stream_equiv[of N] psgt pslt unfolding q_def by simp
thus "subalgebra N (G 0)" and "sets (G 0) = {{}, space N}" using stock_filtration unfolding init_triv_filt_def
filtration_def bot_nat_def by auto
show "integrable N (discounted_value r (λm. der) matur)"
proof (rule bernoulli_discounted_integrable)
show "der ∈ borel_measurable (nat_filtration matur)" using assms geom_rand_walk_borel_adapted
measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
show "N = bernoulli_stream q" using assms unfolding q_def by simp
show "0 < q" "q < 1" using qprops by auto
qed (simp add: acceptable_rate)
qed
hence "integral⇧L N (discounted_value r (λm. der) matur) =
real_cond_exp N (G 0) (discounted_value r (λm. der) matur) w" using bernoulli_stream_space[of N q]
by (simp add: assms(1) q_def)
also have "... = real_cond_exp N (stoch_proc_filt M geom_proc borel 0) (discounted_value r (λm. der) matur) w"
using stock_filtration by simp
also have "... = real_cond_exp N (stoch_proc_filt N geom_proc borel 0) (discounted_value r (λm. der) matur) w"
using stoch_proc_filt_filt_equiv[of nat_filtration M N geom_proc]
bernoulli_stream_equiv[of N] q_def qprops assms pslt psgt by auto
also have "... = expl_cond_expect N (proj_stoch_proc geom_proc 0) (discounted_value r (λm. der) matur) w"
proof (rule bernoulli_cond_exp)
show "N = bernoulli_stream q" using assms unfolding q_def by simp
show "0 < q" "q < 1" using qprops by auto
show "integrable N (discounted_value r (λm. der) matur)"
proof (rule bernoulli_discounted_integrable)
show "der ∈ borel_measurable (nat_filtration matur)" using assms geom_rand_walk_borel_adapted
measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
show "N = bernoulli_stream q" using assms unfolding q_def by simp
show "0 < q" "q < 1" using qprops by auto
qed (simp add: acceptable_rate)
qed
finally show "init = V 0 w" unfolding init_def V_def rn_price_def by simp
qed
finally show "X 0 w = V 0 w" .
next
case (Suc n)
hence "n < matur" by simp
show ?case
proof -
have "X n w = V n w" using Suc by (simp add: Suc.hyps Suc.prems Suc_leD)
have "0< 1+r" using acceptable_rate by simp
let ?m = "matur - Suc n"
have "matur -n = Suc ?m" by (simp add: Suc.prems Suc_diff_Suc Suc_le_lessD)
have "(1+r) * V n w = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)"
using rn_price_eq_ind qprops assms Suc q_def V_def by simp
show "X (Suc n) w = V (Suc n) w"
proof (cases "snth w n")
case True
hence pseq: "pseudo_proj_True (Suc n) w = pseudo_proj_True (Suc n) (spick w n True)"
by (metis (mono_tags, lifting) pseudo_proj_True_stake_image spickI stake_Suc)
have "X (Suc n) w = cls_val_process Mkt (delta_hedging N der matur) (Suc n) w"
unfolding X_def delta_hedging_def self_fin_delta_pf_def using delta_pf_portfolio
unfolding self_financing_def
by (metis less_irrefl positive self_finance_charact self_financingE)
also have "... = geom_proc (Suc n) w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
using delta_hedging_cls_val_process unfolding X_def Δ_def by simp
also have "... = u * geom_proc n w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
using True geometric_process by simp
also have "... = u * geom_proc n w * Δ n w + (1 + r) * X n w - (1+r) * geom_proc n w * Δ n w"
by (simp add: right_diff_distrib)
also have "... = (1+r) * X n w + geom_proc n w * Δ n w * u - geom_proc n w * Δ n w * (1 + r)"
by (simp add: mult.commute mult.left_commute)
also have "... = (1+r)* X n w + geom_proc n w * Δ n w * (u - (1 + r))" by (simp add: right_diff_distrib)
also have "... = (1+r) * X n w + geom_proc n w * (V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))/
(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) * (u - (1 + r))"
using Suc V_def by (simp add: Δ_def delta_price_def geom_rand_walk_diff_induct)
also have "... = (1+r) * X n w + geom_proc n w * ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))) /
(geom_proc n w * (u - d)) * (u - (1 + r))"
proof -
have "geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False) =
geom_proc n w * (u - d)"
by (simp add: geom_rand_walk_diff_induct)
then show ?thesis by simp
qed
also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w)))* (u - (1 + r))/ (u-d)"
proof -
have "geom_proc n w ≠ 0"
by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl)
then show ?thesis
by simp
qed
also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))* (1 - q))"
proof -
have "1 - q = 1 - (1 + r - d)/(u -d)" unfolding q_def by simp
also have "... = (u - d)/(u - d) - (1 + r - d)/(u -d)" using down_lt_up by simp
also have "... = (u - d - (1 + r - d))/(u - d)" using diff_divide_distrib[of "u - d" "1 + r -d"] by simp
also have "... = (u - (1+r))/(u-d)" by simp
finally have "1 - q = (u - (1+r))/(u-d)" .
thus ?thesis by simp
qed
also have "... = (1+r) * X n w + (1 - q) * V (Suc n) (pseudo_proj_True n w) -
(1 - q) * V (Suc n) (pseudo_proj_False n w)"
by (simp add: mult.commute right_diff_distrib)
also have "... = (1+r) * V n w + (1 - q) * V (Suc n) (pseudo_proj_True n w) -
(1 - q) * V (Suc n) (pseudo_proj_False n w)" using ‹X n w = V n w› by simp
also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_False n w) +
(1 - q) * V (Suc n) (pseudo_proj_True n w) - (1 - q) * V (Suc n) (pseudo_proj_False n w)"
using assms Suc rn_price_eq_ind[of N q n matur der w] ‹n < matur› qprops unfolding V_def q_def
by simp
also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_True n w)" by simp
also have "... = V (Suc n) (pseudo_proj_True n w)"
using distrib_right[of q "1 - q" "V (Suc n) (pseudo_proj_True n w)"] by simp
also have "... = V (Suc n) w"
proof -
have "V (Suc n) ∈ borel_measurable (G (Suc n))" unfolding V_def q_def
proof (rule rn_price_borel_adapt)
show "der ∈ borel_measurable (G matur)" using assms by simp
show "N = bernoulli_stream q" using assms unfolding q_def by simp
show "0 < q" and "q < 1" using qprops by auto
show "Suc n ≤ matur" using Suc by simp
qed
hence "V (Suc n) (pseudo_proj_True n w) = V (Suc n) (pseudo_proj_True (Suc n) (pseudo_proj_True n w))"
using geom_proc_filt_info[of "V (Suc n)" "Suc n"] by simp
also have "... = V (Suc n) (pseudo_proj_True (Suc n) w)" using True
by (simp add: pseq spick_eq_pseudo_proj_True)
also have "... = V (Suc n) w" using ‹V (Suc n) ∈ borel_measurable (G (Suc n))›
geom_proc_filt_info[of "V (Suc n)" "Suc n"] by simp
finally show ?thesis .
qed
finally show "X (Suc n) w = V (Suc n) w" .
next
case False
hence pseq: "pseudo_proj_True (Suc n) w = pseudo_proj_True (Suc n) (spick w n False)" using filtration
by (metis (full_types) pseudo_proj_True_def spickI stake_Suc)
have "X (Suc n) w = cls_val_process Mkt (delta_hedging N der matur) (Suc n) w"
unfolding X_def delta_hedging_def self_fin_delta_pf_def using delta_pf_portfolio
unfolding self_financing_def
by (metis less_irrefl positive self_finance_charact self_financingE)
also have "... = geom_proc (Suc n) w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
using delta_hedging_cls_val_process unfolding X_def Δ_def by simp
also have "... = d * geom_proc n w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
using False geometric_process by simp
also have "... = d * geom_proc n w * Δ n w + (1 + r) * X n w - (1+r) * geom_proc n w * Δ n w"
by (simp add: right_diff_distrib)
also have "... = (1+r) * X n w + geom_proc n w * Δ n w * d - geom_proc n w * Δ n w * (1 + r)"
by (simp add: mult.commute mult.left_commute)
also have "... = (1+r)* X n w + geom_proc n w * Δ n w * (d - (1 + r))" by (simp add: right_diff_distrib)
also have "... = (1+r) * X n w + geom_proc n w * (V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))/
(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) * (d - (1 + r))"
using Suc V_def by (simp add: Δ_def delta_price_def geom_rand_walk_diff_induct)
also have "... = (1+r) * X n w + geom_proc n w * ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))) /
(geom_proc n w * (u - d)) * (d - (1 + r))"
by (simp add: geom_rand_walk_diff_induct)
also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w)))* (d - (1 + r))/ (u-d)"
proof -
have "geom_proc n w ≠ 0"
by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl)
then show ?thesis
by simp
qed
also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))* (-q))"
proof -
have "0-q = 0-(1 + r - d)/(u -d)" unfolding q_def by simp
also have "... = (d - (1 + r))/(u -d)" by (simp add: minus_divide_left)
finally have "0 - q = (d - (1+r))/(u-d)" .
thus ?thesis by simp
qed
also have "... = (1+r) * X n w + (- V (Suc n) (pseudo_proj_True n w) * q + V (Suc n) (pseudo_proj_False n w)* q)"
by (metis (no_types, hide_lams) add.inverse_inverse distrib_right minus_mult_commute minus_real_def mult_minus_left)
also have "... = (1+r) * X n w - q * V (Suc n) (pseudo_proj_True n w) + q * V (Suc n) (pseudo_proj_False n w)" by simp
also have "... = (1+r) * V n w -q * V (Suc n) (pseudo_proj_True n w) +
q * V (Suc n) (pseudo_proj_False n w)" using ‹X n w = V n w› by simp
also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_False n w) -
q * V (Suc n) (pseudo_proj_True n w) + q * V (Suc n) (pseudo_proj_False n w)"
using assms Suc rn_price_eq_ind[of N q n matur der w] ‹n < matur› qprops unfolding V_def q_def
by simp
also have "... = (1-q) * V (Suc n) (pseudo_proj_False n w) + q * V (Suc n) (pseudo_proj_False n w)" by simp
also have "... = V (Suc n) (pseudo_proj_False n w)"
using distrib_right[of q "1 - q" "V (Suc n) (pseudo_proj_False n w)"] by simp
also have "... = V (Suc n) w"
proof -
have "V (Suc n) ∈ borel_measurable (G (Suc n))" unfolding V_def q_def
proof (rule rn_price_borel_adapt)
show "der ∈ borel_measurable (G matur)" using assms by simp
show "N = bernoulli_stream q" using assms unfolding q_def by simp
show "0 < q" and "q < 1" using qprops by auto
show "Suc n ≤ matur" using Suc by simp
qed
hence "V (Suc n) (pseudo_proj_False n w) = V (Suc n) (pseudo_proj_False (Suc n) (pseudo_proj_False n w))"
using geom_proc_filt_info'[of "V (Suc n)" "Suc n"] by simp
also have "... = V (Suc n) (pseudo_proj_False (Suc n) w)" using False spick_eq_pseudo_proj_False
by (metis pseq pseudo_proj_True_imp_False)
also have "... = V (Suc n) w" using ‹V (Suc n) ∈ borel_measurable (G (Suc n))›
geom_proc_filt_info'[of "V (Suc n)" "Suc n"] by simp
finally show ?thesis .
qed
finally show "X (Suc n) w = V (Suc n) w" .
qed
qed
qed
}
thus "⋀n w. n ≤ matur ⟹
val_process Mkt (self_fin_delta_pf N der matur (integral⇧L N (discounted_value r (λm. der) matur))) n w =
rn_price N der matur n w" by (simp add: X_def init_def V_def delta_hedging_def)
qed
lemma (in CRR_market_viable) delta_hedging_same_cash_flow:
assumes "der ∈ borel_measurable (G matur)"
and "N = bernoulli_stream ((1 + r - d) / (u - d))"
shows "cls_val_process Mkt (delta_hedging N der matur) matur w =
der w"
proof -
define q where "q = (1 + r - d) / (u - d)"
have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
note qprops = this
have "cls_val_process Mkt (delta_hedging N der matur) matur w =
val_process Mkt (delta_hedging N der matur) matur w" using self_financingE self_finance_charact
unfolding delta_hedging_def self_fin_delta_pf_def
by (metis delta_pf_portfolio mult_1s(1) mult_cancel_right not_real_square_gt_zero positive)
also have "... = rn_price N der matur matur w" using delta_hedging_eq_derivative_price assms by simp
also have "... = rn_rev_price N der matur 0 w" using rn_price_eq qprops assms
unfolding rn_price_ind_def q_def by simp
also have "... = der w" by simp
finally show ?thesis .
qed
lemma (in CRR_market) delta_hedging_trading_strat:
assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "der ∈ borel_measurable (G matur)"
shows "trading_strategy (delta_hedging N der matur)" unfolding delta_hedging_def
by (simp add: assms self_fin_delta_pf_trad_strat)
lemma (in CRR_market) delta_hedging_self_financing:
shows "self_financing Mkt (delta_hedging N der matur)" unfolding delta_hedging_def self_fin_delta_pf_def
proof (rule self_finance_charact)
show "∀n w. prices Mkt risk_free_asset (Suc n) w ≠ 0" using positive
by (metis less_numeral_extra(3))
show "portfolio (delta_pf N der matur)" using delta_pf_portfolio .
qed
lemma (in CRR_market_viable) delta_hedging_replicating:
assumes "der ∈ borel_measurable (G matur)"
and "N = bernoulli_stream ((1 + r - d) / (u - d))"
shows "replicating_portfolio (delta_hedging N der matur) der matur"
unfolding replicating_portfolio_def
proof (intro conjI)
define q where "q = (1 + r - d) / (u - d)"
have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
note qprops = this
let ?X = "(delta_hedging N der matur)"
show "trading_strategy ?X" using delta_hedging_trading_strat qprops assms unfolding q_def by simp
show "self_financing Mkt ?X" using delta_hedging_self_financing .
show "stock_portfolio Mkt (delta_hedging N der matur)" unfolding delta_hedging_def self_fin_delta_pf_def
stock_portfolio_def portfolio_def using stocks delta_pf_support
by (smt Un_insert_right delta_pf_portfolio insert_commute portfolio_def self_finance_def
self_finance_portfolio single_comp_support subset_insertI2 subset_singleton_iff
sum_support_set sup_bot.right_neutral)
show "AEeq M (cls_val_process Mkt (delta_hedging N der matur) matur) der"
using delta_hedging_same_cash_flow assms by simp
qed
definition (in disc_equity_market) complete_market where
"complete_market ⟷ (∀matur. ∀ der∈ borel_measurable (F matur). (∃p. replicating_portfolio p der matur))"
lemma (in CRR_market_viable) CRR_market_complete:
shows "complete_market" unfolding complete_market_def
proof (intro allI impI)
fix matur::nat
show "∀ der ∈ borel_measurable (G matur). (∃p. replicating_portfolio p der matur)"
proof
fix der::"bool stream⇒real"
assume "der ∈ borel_measurable (G matur)"
define N where "N = bernoulli_stream ((1 + r - d) / (u - d))"
hence "replicating_portfolio (delta_hedging N der matur) der matur" using delta_hedging_replicating
‹der ∈ borel_measurable (G matur)› by simp
thus "∃pf. replicating_portfolio pf der matur" by auto
qed
qed
lemma subalgebras_filtration:
assumes "filtration M F"
and "∀t. subalgebra (F t) (G t)"
and "∀ s t. s ≤ t ⟶ subalgebra (G t) (G s)"
shows "filtration M G" unfolding filtration_def
proof (intro conjI allI impI)
{
fix t
have "subalgebra (F t) (G t)" using assms by simp
moreover have "subalgebra M (F t)" using assms unfolding filtration_def by simp
ultimately show "subalgebra M (G t)" by (metis subalgebra_def subsetCE subsetI)
}
{
fix s t::'b
assume "s ≤ t"
thus "subalgebra (G t) (G s)" using assms by simp
}
qed
lemma subfilt_filt_equiv:
assumes "filt_equiv F M N"
and "∀ t. subalgebra (F t) (G t)"
and "∀ s t. s ≤ t ⟶ subalgebra (G t) (G s)"
shows "filt_equiv G M N" unfolding filt_equiv_def
proof (intro conjI)
show "sets M = sets N" using assms unfolding filt_equiv_def by simp
show "filtration M G" using assms subalgebras_filtration[of M F G] unfolding filt_equiv_def by simp
show "∀t A. A ∈ sets (G t) ⟶ (emeasure M A = 0) = (emeasure N A = 0)"
proof (intro allI ballI impI)
fix t
fix A
assume "A∈ sets (G t)"
hence "A ∈ sets (F t)" using assms unfolding subalgebra_def by auto
thus "(emeasure M A = 0) = (emeasure N A = 0)" using assms unfolding filt_equiv_def by simp
qed
qed
lemma (in CRR_market_viable) CRR_market_fair_price:
assumes "pyf∈ borel_measurable (G matur)"
shows "fair_price Mkt
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
((discounted_value r (λm. pyf) matur) w))
pyf matur"
proof -
define dpf where "dpf = (discounted_value r (λm. pyf) matur)"
define q where "q = (1 + r - d) / (u - d)"
have "∃pf. replicating_portfolio pf pyf matur" using CRR_market_complete assms unfolding complete_market_def by simp
from this obtain pf where "replicating_portfolio pf pyf matur" by auto note pfprop = this
define N where "N = bernoulli_stream ((1 + r - d) / (u - d))"
have "fair_price Mkt (integral⇧L N dpf) pyf matur" unfolding dpf_def
proof (rule replicating_expectation_finite)
show "risk_neutral_prob N" using assms risk_neutral_iff
using CRR_viable gt_param lt_param N_def by blast
have "filt_equiv nat_filtration M N" using bernoulli_stream_equiv[of N "(1+r-d)/(u-d)"]
assms gt_param lt_param CRR_viable psgt pslt N_def by simp
thus "filt_equiv G M N" using subfilt_filt_equiv
using Filtration.filtration_def filtration geom_rand_walk_borel_adapted
stoch_proc_subalg_nat_filt stock_filtration by blast
show "pyf ∈ borel_measurable (G matur)" using assms by simp
show "viable_market Mkt" using CRR_viable by simp
have "infinite_cts_filtration p M nat_filtration" using bernoulli_nat_filtration[of M p] bernoulli psgt pslt
by simp
thus "sets (G 0) = {{}, space M}" using stock_filtration
infinite_cts_filtration.stoch_proc_filt_triv_init[of p M nat_filtration geom_proc]
geom_rand_walk_borel_adapted bot_nat_def unfolding init_triv_filt_def by simp
show "replicating_portfolio pf pyf matur" using pfprop .
show "∀n. ∀asset∈support_set pf. finite (prices Mkt asset n ` space M)"
proof (intro allI ballI)
fix n
fix asset
assume "asset ∈ support_set pf"
hence "prices Mkt asset n ∈ borel_measurable (G n)" using readable pfprop
unfolding replicating_portfolio_def stock_portfolio_def adapt_stoch_proc_def by auto
hence "prices Mkt asset n ∈ borel_measurable (nat_filtration n)" using stock_filtration
stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
measurable_from_subalg[of "nat_filtration n" "G n" "prices Mkt asset n" borel]
unfolding adapt_stoch_proc_def by auto
thus "finite (prices Mkt asset n ` space M)" using nat_filtration_vimage_finite[of "prices Mkt asset n"] by simp
qed
show "∀n. ∀asset∈support_set pf. finite (pf asset n ` space M)"
proof (intro allI ballI)
fix n
fix asset
assume "asset ∈ support_set pf"
hence "pf asset n ∈ borel_measurable (G n)" using pfprop predict_imp_adapt[of "pf asset"]
unfolding replicating_portfolio_def trading_strategy_def adapt_stoch_proc_def by auto
hence "pf asset n ∈ borel_measurable (nat_filtration n)" using stock_filtration
stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
measurable_from_subalg[of "nat_filtration n" "G n" "pf asset n" borel]
unfolding adapt_stoch_proc_def by auto
thus "finite (pf asset n ` space M)" using nat_filtration_vimage_finite[of "pf asset n"] by simp
qed
qed
moreover have "integral⇧L N dpf =
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component q w) {0..<matur}) * (dpf w))"
proof (rule infinite_cts_filtration.expect_prob_comp)
show "infinite_cts_filtration q N nat_filtration" using assms pslt psgt
bernoulli_nat_filtration unfolding q_def using gt_param lt_param CRR_viable N_def by auto
have "dpf ∈ borel_measurable (G matur)" using assms discounted_measurable[of pyf "G matur"]
unfolding dpf_def by simp
thus "dpf ∈ borel_measurable (nat_filtration matur)" using stock_filtration
stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
measurable_from_subalg[of "nat_filtration matur" "G matur" dpf]
unfolding adapt_stoch_proc_def by auto
qed
ultimately show ?thesis unfolding dpf_def q_def by simp
qed
end
Theory Option_Price_Examples
theory Option_Price_Examples imports CRR_Model
begin
text ‹ This file contains pricing results for four options in the Cox-Ross-Rubinstein model. The first section contains results
relating some functions to the more abstract counterparts that were used to prove fairness and completeness results. The second
section contains the pricing results for a few options; some path-dependent and others not. ›
section ‹ Effective computation definitions and results ›
subsection ‹ Generation of lists of boolean elements ›
text ‹ The function gener-bool-list permits to generate lists of boolean elements. It is used to generate a list representative
of the range of boolean streams by the function pseudo-proj-True. ›
fun gener_bool_list where
"gener_bool_list 0 = {[]}"
| "gener_bool_list (Suc n) = {True # w| w. w∈ gener_bool_list n} ∪ {False # w| w. w∈ gener_bool_list n}"
lemma gener_bool_list_elem_length:
shows "⋀x. x∈ gener_bool_list n ⟹ length x = n"
proof (induction n)
case 0
fix x
assume "x∈ gener_bool_list 0"
hence "x = []" by simp
thus "length x = 0" by simp
next
case (Suc n)
fix x
assume "x∈ gener_bool_list (Suc n)"
hence mem: "x∈ {True # w| w. w∈ gener_bool_list n} ∪ {False # w| w. w∈ gener_bool_list n}" by simp
show "length x = Suc n"
proof (cases "x∈ {True # w| w. w∈ gener_bool_list n}")
case True
hence "∃w ∈ gener_bool_list n. x = True # w" by auto
from this obtain w where "w∈ gener_bool_list n" and "x = True # w" by auto
hence "length w = n" using Suc by simp
thus "length x = Suc n" using ‹x = True # w› by simp
next
case False
hence "x∈ {False # w| w. w∈ gener_bool_list n}" using mem by auto
hence "∃w ∈ gener_bool_list n. x = False # w" by auto
from this obtain w where "w∈ gener_bool_list n" and "x = False # w" by auto
hence "length w = n" using Suc by simp
thus "length x = Suc n" using ‹x = False # w› by simp
qed
qed
lemma (in infinite_coin_toss_space) stake_gener_bool_list:
shows "stake n`streams (UNIV::bool set) = gener_bool_list n"
proof (induction n)
case 0
thus "stake 0 ` streams UNIV = gener_bool_list 0" by auto
next
case (Suc n)
show "stake (Suc n) ` streams UNIV = gener_bool_list (Suc n)"
proof -
have "stake (Suc n)`streams (UNIV::bool set) = {s#w| s w. s∈ UNIV ∧ w∈ (stake n `(streams UNIV))}"
by (metis (no_types) UNIV_bool UNIV_not_empty stake_finite_universe_induct[of UNIV n] finite.emptyI finite_insert)
also have "... = {s#w| s w. s∈ {True, False} ∧ w∈ (stake n `(streams UNIV))}" by simp
also have "... = {s#w| s w. s∈ {True, False} ∧ w∈ gener_bool_list n}" using Suc by simp
also have "... = {s#w| s w. s∈ {True} ∧ w∈ gener_bool_list n} ∪ {s#w| s w. s∈ { False} ∧ w∈ gener_bool_list n}" by auto
also have "... = {True # w | w. w∈ gener_bool_list n} ∪ {False#w | w. w∈ gener_bool_list n}" by auto
also have "... = gener_bool_list (Suc n)" by simp
finally show ?thesis .
qed
qed
lemma (in infinite_coin_toss_space) pseudo_range_stake:
assumes "⋀w. f w = g (stake n w)"
shows "(∑ w∈ range (pseudo_proj_True n). f w) = (∑ y∈ (gener_bool_list n). g y)"
proof (rule sum.reindex_cong)
show "inj_on (λ l. shift l (sconst True)) (gener_bool_list n)"
proof
fix x y
assume "x∈ gener_bool_list n"
and "y∈ gener_bool_list n"
and "x @- sconst True = y @- sconst True"
have "length x = n" using gener_bool_list_elem_length ‹x∈ gener_bool_list n› by simp
have "length y = n" using gener_bool_list_elem_length ‹y∈ gener_bool_list n› by simp
show "x = y"
proof -
have "∀ i < n. nth x i = nth y i"
proof (intro allI impI)
fix i
assume "i < n"
have xi: "snth (x @- sconst True) i = nth x i" using ‹i < n› ‹length x = n› by simp
have yi: "snth (y @- sconst True) i = nth y i" using ‹i < n› ‹length y = n› by simp
have "snth (x @- sconst True) i = snth (y @- sconst True) i" using ‹x @- sconst True = y @- sconst True›
by simp
thus "nth x i = nth y i" using xi yi by simp
qed
thus ?thesis using ‹length x = n› ‹length y = n› by (simp add: list_eq_iff_nth_eq)
qed
qed
have "range (pseudo_proj_True n) = {shift l (sconst True)|l. l∈(stake n `streams (UNIV::bool set))} "
unfolding pseudo_proj_True_def by auto
also have "... = {shift l (sconst True)|l. l∈(gener_bool_list n)} " using stake_gener_bool_list by simp
also have "... = (λl. l @- sconst True) ` gener_bool_list n" by auto
finally show "range (pseudo_proj_True n) = (λl. l @- sconst True) ` gener_bool_list n" .
fix x
assume "x∈ gener_bool_list n"
have "length x = n" using gener_bool_list_elem_length ‹x∈ gener_bool_list n› by simp
have "f (x @- sconst True) = g (stake n (x @- sconst True))" using assms by simp
also have "... = g x" using ‹length x = n› by (simp add: stake_shift)
finally show "f (x @- sconst True) = g x" .
qed
subsection ‹ Probability components for lists ›
fun lprob_comp where
"lprob_comp (p::real) [] = 1"
| "lprob_comp p (x # xs) = (if x then p else (1-p)) * lprob_comp p xs"
lemma lprob_comp_last:
shows "lprob_comp p (xs @ [x]) = (lprob_comp p xs) * (if x then p else (1 - p))"
proof (induction xs)
case Nil
have "lprob_comp p (Nil @ [x]) = lprob_comp p [x]" by simp
also have "... = (if x then p else (1 - p))" by simp
also have "... = (lprob_comp p Nil) * (if x then p else (1 - p))" by simp
finally show "lprob_comp p (Nil @ [x]) = (lprob_comp p Nil) * (if x then p else (1 - p))" .
next
case (Cons a xs)
have "lprob_comp p ((Cons a xs) @ [x]) = (if a then p else (1 - p)) * lprob_comp p (xs @ [x])" by simp
also have "... = (if a then p else (1 - p)) * (lprob_comp p xs) * (if x then p else (1-p))" using Cons by simp
also have "... = lprob_comp p (Cons a xs) * (if x then p else (1-p))" by simp
finally show "lprob_comp p ((Cons a xs) @ [x]) = lprob_comp p (Cons a xs) * (if x then p else (1-p))" .
qed
lemma (in infinite_coin_toss_space) lprob_comp_stake:
shows "(prod (prob_component pr w) {0..<matur}) = lprob_comp pr (stake matur w)"
proof (induction matur)
case 0
have "prod (prob_component pr w) {0..<0} = 1" by simp
also have "... = lprob_comp pr []" by simp
also have "... = lprob_comp pr (stake 0 w)" by simp
finally show "prod (prob_component pr w) {0..<0} = lprob_comp pr (stake 0 w)" .
next
case (Suc n)
have "prod (prob_component pr w) {0..<Suc n} = prod (prob_component pr w) {0..< n} *
(prob_component pr w n)" using prod.atLeast0_lessThan_Suc by blast
also have "... = lprob_comp pr (stake n w) * (prob_component pr w n)" using Suc by simp
also have "... = lprob_comp pr (stake n w) * (if (snth w n) then pr else 1-pr)" by (simp add: prob_component_def)
also have "... = lprob_comp pr ((stake n w) @ [snth w n])" by (simp add: lprob_comp_last)
also have "... = lprob_comp pr (stake (Suc n) w)" by (metis Stream.stake_Suc)
finally show "prod (prob_component pr w) {0..<Suc n} = lprob_comp pr (stake (Suc n) w)" .
qed
subsection ‹ Geometric process applied to lists ›
fun lrev_geom where
"lrev_geom u d v [] = v"
| "lrev_geom u d v (x#xs) = (if x then u else d) * lrev_geom u d v xs"
fun lgeom_proc where "lgeom_proc u d v l = lrev_geom u d v (rev l)"
lemma (in infinite_coin_toss_space) geom_lgeom:
shows "geom_rand_walk u d v n w = lgeom_proc u d v (stake n w)"
proof (induction n)
case 0
have "geom_rand_walk u d v 0 w = v" by simp
also have "... = lrev_geom u d v []" by simp
also have "... = lrev_geom u d v (rev (stake 0 w))" by simp
also have "... = lgeom_proc u d v (stake 0 w)" by simp
finally show "geom_rand_walk u d v 0 w = lgeom_proc u d v (stake 0 w)" .
next
case (Suc n)
have "snth w n = nth (stake (Suc n) w) n" using stake_nth by blast
have "(stake n w) @ [nth (stake (Suc n) w) n] = stake (Suc n) w"
by (metis Stream.stake_Suc lessI stake_nth)
have "geom_rand_walk u d v (Suc n) w = ((λTrue ⇒ u | False ⇒ d) (snth w n)) * geom_rand_walk u d v n w" by simp
also have "... = (if (snth w n) then u else d) * geom_rand_walk u d v n w" by simp
also have "... = (if (snth w n) then u else d) * lgeom_proc u d v (stake n w)" using Suc by simp
also have "... = (if (snth w n) then u else d) * lrev_geom u d v (rev (stake n w))" by simp
also have "... = lrev_geom u d v ((snth w n) # (rev (stake n w)))" by simp
also have "... = lrev_geom u d v (rev ((stake n w) @ [snth w n]))" by simp
also have "... = lrev_geom u d v (rev ((stake n w) @ [nth (stake (Suc n) w) n]))"
using ‹snth w n = nth (stake (Suc n) w) n› by simp
also have "... = lrev_geom u d v (rev (stake (Suc n) w))"
using ‹(stake n w) @ [nth (stake (Suc n) w) n] = stake (Suc n) w› by simp
also have "... = lgeom_proc u d v (stake (Suc n) w)" by simp
finally show "geom_rand_walk u d v (Suc n) w = lgeom_proc u d v (stake (Suc n) w)" .
qed
lemma lgeom_proc_take:
assumes "i ≤ n"
shows "lgeom_proc u d init (stake i w) = lgeom_proc u d init (take i (stake n w))"
proof -
have "stake i w = take i (stake n w)" using assms by (simp add: min.absorb1 take_stake)
thus ?thesis by simp
qed
subsection ‹ Effective computation of discounted values ›
fun det_discount where
"det_discount (r::real) 0 = 1"
| "det_discount r (Suc n) = (inverse (1+r)) * (det_discount r n)"
lemma det_discounted:
shows "discounted_value r X n w = (det_discount r n) * (X n w)" unfolding discounted_value_def discount_factor_def
proof (induction n arbitrary: X)
case 0
have "inverse (disc_rfr_proc r 0 w) * X 0 w = X 0 w" by simp
also have "... = (det_discount r 0) * (X 0 w)" by simp
finally show "inverse (disc_rfr_proc r 0 w) * X 0 w = (det_discount r 0) * (X 0 w)" .
next
case (Suc n)
have "inverse (disc_rfr_proc r (Suc n) w) * X (Suc n) w =
inverse ((1+r) * (disc_rfr_proc r) n w) * X (Suc n) w" by simp
also have "... = (inverse (1+r)) * inverse ((disc_rfr_proc r) n w) * X (Suc n) w" by simp
also have "... = (inverse (1+r)) * (det_discount r n) * X (Suc n) w" using Suc[of "λn. X (Suc n)"] by auto
also have "... = (det_discount r (Suc n)) * X (Suc n) w" by simp
finally show "inverse (disc_rfr_proc r (Suc n) w) * X (Suc n) w = (det_discount r (Suc n)) * X (Suc n) w" .
qed
section ‹Pricing results on options ›
subsection ‹ Call option ›
text ‹ A call option is parameterized by a strike K and maturity T. If S denotes the price of the (unique) risky asset at
time T, then the option pays max(S - K, 0) at that time.›
definition (in CRR_market) call_option where
"call_option (T::nat) (K::real) = (λ w. max (prices Mkt stk T w - K) 0)"
lemma (in CRR_market) call_borel:
shows "call_option T K ∈ borel_measurable (G T)" unfolding call_option_def
proof (rule borel_measurable_max)
show "(λx. 0) ∈ borel_measurable (G T)" by simp
show "(λx. prices Mkt stk T x - K) ∈ borel_measurable (G T)"
proof (rule borel_measurable_diff)
show "prices Mkt stk T ∈ borel_measurable (G T)"
by (metis adapt_stoch_proc_def stock_price_borel_measurable)
qed simp
qed
lemma (in CRR_market_viable) call_option_lgeom:
shows "call_option T K w = max ((lgeom_proc u d init (stake T w)) - K) 0"
using geom_lgeom stk_price geometric_process unfolding call_option_def by simp
lemma (in CRR_market_viable) disc_call_option_lgeom:
shows "(discounted_value r (λm. (call_option T K)) T w) =
(det_discount r T) * (max ((lgeom_proc u d init (stake T w)) - K) 0)"
using det_discounted[of r "λm. call_option T K" T w] call_option_lgeom[of T K w] by simp
lemma (in CRR_market_viable) call_effect_compute:
shows "(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) *
(discounted_value r (λm. (call_option matur K)) matur w)) =
(∑ y∈ (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) *
(max ((lgeom_proc u d init (take matur y)) - K) 0))"
proof (rule pseudo_range_stake)
fix w
have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. call_option matur K) matur w =
lprob_comp pr (stake matur w) * discounted_value r (λm. call_option matur K) matur w"
using lprob_comp_stake by simp
also have "... = lprob_comp pr (stake matur w) *
(det_discount r matur) * (max ((lgeom_proc u d init (take matur (stake matur w))) - K) 0)"
using disc_call_option_lgeom[of matur K] by simp
finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. call_option matur K) matur w =
lprob_comp pr (stake matur w) *
(det_discount r matur) * (max ((lgeom_proc u d init (take matur (stake matur w))) - K) 0)" .
qed
fun call_price where
"call_price u d init r matur K = (∑ y∈ (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) *
(max ((lgeom_proc u d init (take matur (take matur y))) - K) 0))"
text ‹ Evaluating the function above returns the fair price of a call option. ›
lemma (in CRR_market_viable) call_price:
shows "fair_price Mkt
(call_price u d init r matur K)
(call_option matur K) matur"
proof -
have "fair_price Mkt
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
(discounted_value r (λm. (call_option matur K)) matur w))
(call_option matur K) matur"
by (rule CRR_market_fair_price, rule call_borel)
thus ?thesis using call_effect_compute by simp
qed
subsection ‹ Put option ›
text ‹ A put option is also parameterized by a strike K and maturity T. If S denotes the price of the (unique) risky asset at
time T, then the option pays max(K - S, 0) at that time. ›
definition (in CRR_market) put_option where
"put_option (T::nat) (K::real) = (λ w. max (K - prices Mkt stk T w) 0)"
lemma (in CRR_market) put_borel:
shows "put_option T K ∈ borel_measurable (G T)" unfolding put_option_def
proof (rule borel_measurable_max)
show "(λx. 0) ∈ borel_measurable (G T)" by simp
show "(λx. K - prices Mkt stk T x) ∈ borel_measurable (G T)"
proof (rule borel_measurable_diff)
show "prices Mkt stk T ∈ borel_measurable (G T)"
by (metis adapt_stoch_proc_def stock_price_borel_measurable)
qed simp
qed
lemma (in CRR_market_viable) put_option_lgeom:
shows "put_option T K w = max (K - (lgeom_proc u d init (stake T w))) 0"
using geom_lgeom stk_price geometric_process unfolding put_option_def by simp
lemma (in CRR_market_viable) disc_put_option_lgeom:
shows "(discounted_value r (λm. (put_option T K)) T w) =
(det_discount r T) * (max (K - (lgeom_proc u d init (stake T w))) 0)"
using det_discounted[of r "λm. put_option T K" T w] put_option_lgeom[of T K w] by simp
lemma (in CRR_market_viable) put_effect_compute:
shows "(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) *
(discounted_value r (λm. (put_option matur K)) matur w)) =
(∑ y∈ (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) *
(max (K - (lgeom_proc u d init (take matur y))) 0))"
proof (rule pseudo_range_stake)
fix w
have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. put_option matur K) matur w =
lprob_comp pr (stake matur w) * discounted_value r (λm. put_option matur K) matur w"
using lprob_comp_stake by simp
also have "... = lprob_comp pr (stake matur w) *
(det_discount r matur) * (max (K - (lgeom_proc u d init (take matur (stake matur w)))) 0)"
using disc_put_option_lgeom[of matur K] by simp
finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. put_option matur K) matur w =
lprob_comp pr (stake matur w) *
(det_discount r matur) * (max (K - (lgeom_proc u d init (take matur (stake matur w)))) 0)" .
qed
fun put_price where
"put_price u d init r matur K = (∑ y∈ (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) *
(max (K - (lgeom_proc u d init (take matur (take matur y)))) 0))"
text ‹ Evaluating the function above returns the fair price of a put option. ›
lemma (in CRR_market_viable) put_price:
shows "fair_price Mkt
(put_price u d init r matur K)
(put_option matur K) matur"
proof -
have "fair_price Mkt
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
(discounted_value r (λm. (put_option matur K)) matur w))
(put_option matur K) matur"
by (rule CRR_market_fair_price, rule put_borel)
thus ?thesis using put_effect_compute by simp
qed
subsection ‹ Lookback option ›
text ‹ A lookback option is parameterized by a maturity T. If Sn denotes the price of the (unique) risky asset at
time n, then the option pays max(Sn. 0 <= n <= T) - ST at that time. ›
definition (in CRR_market) lbk_option where
"lbk_option (T::nat) = (λ w. Max ((λi. (prices Mkt stk) i w)`{0 .. T}) - (prices Mkt stk T w))"
lemma borel_measurable_Max_finite:
fixes f::"'a ⇒ 'b ⇒ 'c::{second_countable_topology, linorder_topology}"
assumes "0 < (n::nat)"
shows "⋀A. card A = n ⟹ ∀a ∈ A. f a ∈ borel_measurable M ⟹ (λw. Max ((λa. f a w)`A)) ∈ borel_measurable M" using assms
proof (induct n)
case 0
show "⋀A. card A = 0 ⟹ ∀a∈A. f a ∈ borel_measurable M ⟹ (0::nat) < 0 ⟹ (λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M"
proof -
fix A::"'a set"
assume "card A = 0" and "∀a∈A. f a ∈ borel_measurable M" and "(0::nat) < 0"
thus "(λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M" by simp
qed
next
case Suc
show "⋀n A. (⋀A. card A = n ⟹
∀a∈A. f a ∈ borel_measurable M ⟹ 0 < n ⟹ (λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M) ⟹
card A = Suc n ⟹
∀a∈A. f a ∈ borel_measurable M ⟹ 0 < Suc n ⟹ (λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M"
proof -
fix n
fix A::"'a set"
assume ameas: "(⋀A. card A = n ⟹
∀a∈A. f a ∈ borel_measurable M ⟹ 0 < n ⟹ (λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M)"
and "card A = Suc n"
and "∀a∈A. f a ∈ borel_measurable M"
and "0 < Suc n"
from ‹card A = Suc n› have aprop: "A≠ {} ∧ finite A" using card_eq_0_iff[of A] by simp
hence "∃x. x∈ A" by auto
from this obtain a where "a∈ A" by auto
hence "Suc (card (A - {a})) = Suc n" using aprop card_Suc_Diff1[of A] ‹card A = Suc n› by auto
hence "card (A - {a}) = n" by simp
show "(λw. Max ((λa. f a w) ` A)) ∈ borel_measurable M"
proof (cases "n = 0")
case False
hence "0 < n" by simp
moreover have "∀a∈A - {a}. f a ∈ borel_measurable M" using ‹∀a∈A. f a ∈ borel_measurable M› by simp
ultimately have "(λw. Max ((λa. f a w) ` (A-{a}))) ∈ borel_measurable M" using ‹card (A - {a}) = n›
ameas[of "A - {a}"] by simp
moreover have "f a ∈ borel_measurable M" using ‹∀a∈A. f a ∈ borel_measurable M› ‹a∈A› by simp
ultimately have "(λ w. max (f a w) (Max ((λa. f a w) ` (A-{a})))) ∈ borel_measurable M"
using borel_measurable_max by simp
moreover have "⋀w. max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max ((λa. f a w) `A)"
proof -
fix w
define FA where "FA = ((λa. f a w) ` (A-{a}))"
have "finite FA" unfolding FA_def using aprop by simp
have "A - {a} ≠ {}" using aprop False ‹card (A - {a}) = n› card_eq_0_iff[of "A - {a}"] by simp
hence "FA ≠ {}" unfolding FA_def by simp
have "max (f a w) (Max FA) = Max (insert (f a w) FA)" using ‹finite FA› ‹FA ≠ {}› by simp
hence "max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max (insert (f a w) ((λa. f a w) `(A-{a})))"
unfolding FA_def by simp
also have "... = Max ((λa. f a w) `A)"
proof -
have "insert (f a w) ((λa. f a w) `(A-{a})) = (λa. f a w) `(insert a (A - {a}))"
by auto
also have "... = ((λa. f a w) `A)" using ‹a ∈ A› by blast
finally have "insert (f a w) ((λa. f a w) `(A-{a})) = ((λa. f a w) `A)" .
thus ?thesis by simp
qed
finally show "max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max ((λa. f a w) `A)" .
qed
ultimately show "(λw. Max ((λa. f a w) `A)) ∈ borel_measurable M" by simp
next
case True
hence "A - {a} = {}" using aprop card_eq_0_iff[of "A - {a}"] ‹card (A - {a}) = n› by simp
hence "{a} = insert a (A - {a})" by simp
also have "... = A" using ‹a∈ A› by blast
finally have "{a} = A" .
hence "⋀w. (λa. f a w) `A = {f a w}" by auto
hence "⋀w. Max ((λa. f a w) `A) = Max {f a w}" by simp
hence "⋀w. Max ((λa. f a w) `A) = f a w" by simp
hence "(λw. Max ((λa. f a w) `A)) = f a" by simp
thus "(λw. Max ((λa. f a w) `A)) ∈ borel_measurable M" using ‹∀a∈A. f a ∈ borel_measurable M›
‹a∈ A› by simp
qed
qed
qed
lemma (in CRR_market) lbk_borel:
shows "lbk_option T ∈ borel_measurable (G T)" unfolding lbk_option_def
proof (rule borel_measurable_diff)
show "(λx. Max ((λi. prices Mkt stk i x) ` {0..T})) ∈ borel_measurable (G T)"
proof (rule borel_measurable_Max_finite)
show "card {0..T} = Suc T" by simp
show "0 < Suc T" by simp
show "∀i∈{0..T}. prices Mkt stk i ∈ borel_measurable (G T)"
proof
fix i
assume "i∈ {0..T}"
show "prices Mkt stk i ∈ borel_measurable (G T)"
by (metis ‹i ∈ {0..T}› adapt_stoch_proc_def atLeastAtMost_iff increasing_measurable_info
stock_price_borel_measurable)
qed
qed
show "prices Mkt stk T ∈ borel_measurable (G T)" by (metis adapt_stoch_proc_def stock_price_borel_measurable)
qed
lemma (in CRR_market_viable) lbk_option_lgeom:
shows "lbk_option T w = Max ((λi. (lgeom_proc u d init (stake i w)))`{0 .. T}) - (lgeom_proc u d init (stake T w))"
using geom_lgeom stk_price geometric_process unfolding lbk_option_def by simp
lemma (in CRR_market_viable) disc_lbk_option_lgeom:
shows "(discounted_value r (λm. (lbk_option T)) T w) =
(det_discount r T) * (Max ((λi. (lgeom_proc u d init (take i (stake T w))))`{0 .. T}) - (lgeom_proc u d init (stake T w)))"
using det_discounted[of r "λm. lbk_option T" T w] lbk_option_lgeom[of T w] lgeom_proc_take
by (metis (no_types, lifting) atLeastAtMost_iff image_cong)
lemma (in CRR_market_viable) lbk_effect_compute:
shows "(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) *
(discounted_value r (λm. (lbk_option matur)) matur w)) =
(∑ y∈ (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) *
(Max ((λi. (lgeom_proc u d init (take i y)))`{0 .. matur}) - (lgeom_proc u d init y)))"
proof (rule pseudo_range_stake)
fix w
have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. lbk_option matur) matur w =
lprob_comp pr (stake matur w) * discounted_value r (λm. lbk_option matur) matur w"
using lprob_comp_stake by simp
also have "... = lprob_comp pr (stake matur w) *
(det_discount r matur) * (Max ((λi. (lgeom_proc u d init (take i (stake matur w))))`{0 .. matur}) -
(lgeom_proc u d init (stake matur w)))" using disc_lbk_option_lgeom by simp
finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. lbk_option matur) matur w =
lprob_comp pr (stake matur w) *
(det_discount r matur) * (Max ((λi. (lgeom_proc u d init (take i (stake matur w))))`{0 .. matur}) -
(lgeom_proc u d init (stake matur w)))" .
qed
fun lbk_price where
"lbk_price u d init r matur = (∑ y∈ (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) *
(Max ((λi. (lgeom_proc u d init (take i y)))`{0 .. matur}) - (lgeom_proc u d init y)))"
text ‹ Evaluating the function above returns the fair price of a lookback option. ›
lemma (in CRR_market_viable) lbk_price:
shows "fair_price Mkt
(lbk_price u d init r matur)
(lbk_option matur) matur"
proof -
have "fair_price Mkt
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
(discounted_value r (λm. (lbk_option matur)) matur w))
(lbk_option matur) matur"
by (rule CRR_market_fair_price, rule lbk_borel)
thus ?thesis using lbk_effect_compute by simp
qed
value "lbk_price 1.2 0.8 10 0.03 2"
subsection ‹ Asian option ›
text ‹ An asian option is parameterized by a maturity T. This option pays the average price of the
risky asset at time T. ›
definition (in CRR_market) asian_option where
"asian_option (T::nat) = (λ w. (∑ i∈ {1.. T}. prices Mkt stk i w)/T)"
lemma (in CRR_market) asian_borel:
shows "asian_option T ∈ borel_measurable (G T)" unfolding asian_option_def
proof -
have "(λ w. (∑ i∈ {1.. T}. prices Mkt stk i w)) ∈ borel_measurable (G T)"
proof (rule borel_measurable_sum)
fix i
assume "i∈ {1..T}"
show "prices Mkt stk i ∈ borel_measurable (G T)"
by (metis ‹i ∈ {1..T}› adapt_stoch_proc_def atLeastAtMost_iff increasing_measurable_info
stock_price_borel_measurable)
qed
from this show "(λw. (∑i = 1..T. prices Mkt stk i w) / real T) ∈ borel_measurable (G T)" by simp
qed
lemma (in CRR_market_viable) asian_option_lgeom:
shows "asian_option T w = (∑ i∈ {1.. T}. lgeom_proc u d init (stake i w))/ T"
using geom_lgeom stk_price geometric_process unfolding asian_option_def by simp
lemma (in CRR_market_viable) disc_asian_option_lgeom:
shows "(discounted_value r (λm. (asian_option T)) T w) =
(det_discount r T) * (∑ i∈ {1.. T}. lgeom_proc u d init (take i (stake T w)))/ T"
proof -
have "∀ i∈ {1..T}. lgeom_proc u d init (stake i w) = lgeom_proc u d init (take i (stake T w))"
using lgeom_proc_take by auto
hence "(∑ i∈ {1.. T}. lgeom_proc u d init (stake i w)) =
(∑ i∈ {1.. T}. lgeom_proc u d init (take i (stake T w)))" by auto
thus ?thesis
using det_discounted[of r "λm. asian_option T" T w] asian_option_lgeom[of T w] by auto
qed
lemma (in CRR_market_viable) asian_effect_compute:
shows "(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) *
(discounted_value r (λm. (asian_option matur)) matur w)) =
(∑ y∈ (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) *
(∑ i∈ {1.. matur}. lgeom_proc u d init (take i y))/ matur)"
proof (rule pseudo_range_stake)
fix w
have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. asian_option matur) matur w =
lprob_comp pr (stake matur w) * discounted_value r (λm. asian_option matur) matur w"
using lprob_comp_stake by simp
also have "... = lprob_comp pr (stake matur w) *
(det_discount r matur) * (∑ i∈ {1.. matur}. lgeom_proc u d init (take i (stake matur w)))/ matur"
using disc_asian_option_lgeom[of matur w] by simp
finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. asian_option matur) matur w =
lprob_comp pr (stake matur w) *
(det_discount r matur) * (∑ i∈ {1.. matur}. lgeom_proc u d init (take i (stake matur w)))/ matur" .
qed
fun asian_price where
"asian_price u d init r matur = (∑ y∈ (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) *
(∑ i∈ {1.. matur}. lgeom_proc u d init (take i y))/ matur)"
text ‹ Evaluating the function above returns the fair price of an asian option. ›
lemma (in CRR_market_viable) asian_price:
shows "fair_price Mkt
(asian_price u d init r matur)
(asian_option matur) matur"
proof -
have "fair_price Mkt
(∑ w∈ range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
(discounted_value r (λm. (asian_option matur)) matur w))
(asian_option matur) matur"
by (rule CRR_market_fair_price, rule asian_borel)
thus ?thesis using asian_effect_compute by simp
qed
end